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INTRODUCTION 


This document contains users* instructions for a modified version of the 
NASA/MSFC Multilayer Diffusion Model Computer Program — Version 5, The in- 
structions assume the reader is familiar with the material contained in NASA Con- 
tractor Report NASA CR-2631, ’'NASA/MSFC Multilayer Diffusion Models and Com- 
puter Programs — Version 5, by R. K. Dumbauld and J. R. Bjorklund, December 
1975. This modified version of the original program consists of a NASA/MSFC 
Cloud-Rise Preprocessor Program and a NASA/MSFC Multilayer Diffusion Pro- 
gram, both of which will be referred to as Version 6. 

The NASA/MSFC Cloud-Rise Preprocessor Program is executed using any 
desired vertical profile of meteorological data (usually rawinsonde data) for a spe- 
cific rocket vehicle and pollutant. The Preprocessor Program automatically cal- 
culates the rise of the rocket exhaust cloud, the cloud source dimensions at cloud 
stabilization, and other necessary inputs required by the NASA/MSFC Multilayer 
Diffusion Program. On option, the Preprocessor Program either punches the input 
data to cards or writes the data to mass storage and magnetic tape files for sub- 
sequent processing by the Multilayer Diffusion Program. The users' instructions 
for the NASA/MSFC Cloud-Rise Preprocessor Program — Version 6 are given in 
Section A. 

The NASA/MSFC Multilayer Diffusion Program — Version 6 can be executed 
from input data prepared by the user or from input data prepared by the Preprocess- 
or Program. If the data are from Ihe Preprocessor Program, they can be in card form 
or on mass storage and tape , and all data cases can be processed in a single execution 
with a single blank input card. The Multilayer Diffusion Program uses these input 
data to calculate, on option, patterns of concentration, dosage, time-mean concen- 
tration, time of cloud passage, ground -level deposition and surface water pH due to 
precipitation scavenging and ground-level deposition due to gravitational settling. 



The users' instructions for the Multilayer Diffusion Program -^Version 6 are given 
in Section B. 

These versions of tiie Preprocessor and Multilayer Diffusion Programs 
differ from previous versions of the programs and now incorporate: 

• The latest data for the heat content and chemistry of 
rocket exhaust clouds 

• Provision for the automated calculation of surface water 
pH due to the deposition of HCl from precipitation scav- 
enging 

• Provision for the automated calculation of concentration 
and dosage parameters at any level within the vertical 
bounds for which meteorological inputs have been speci- 
fied 

• Provision for execution of multiple cases of meteoro- 
logical data 

In addition, some calculation procedures, such as the procedures used to 
automatically calculate wind direction shear in a layer, have been updated. 
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SECTION A 

USERS’ INSTRUCTIONS FOR THE NASA/MSPC CLOUD-RISE 
PREPROCESSOR COMPUTER PROGRAM— VERSION 6 

This computer program is specifically designed for use with the NASA/ 
MSFC Multilayer Diffusion Program — Version 6 and will not function properly with 
previous versions of the main program. The Preprocessor Program produces a 
complete set of data decks for input to the NASA/MSFC Multilayer Diffusion Pro- 
gram — Version 6. The program is specifically designed for use with launches of 
the l^ace Shuttle, Titan niC, Delta-Thor 2914, Delta-Thor 3914 and Minuteman II 
vehicles. The data decks produced on option by this program include a complete 
card deck for each of the four pollutants HCl, CO, CO„ and A1 O for Models 3 and/ 
or 4 and/or 5 in the NASA/MSFC Multilayer Diffusion Program — Version 6. 

The Cloud-Rise Preprocessor Program is written in Fortran IV and re- 
quires approximately 17,000 locations of core storage on the Univac 1108 Computer. 
The program requires card input, print output and optionally punch or mass stor- 
age and tape file output. Sections A. 1 and A. 2 describe the Program input data. 
Section A. 3 describes the Preprocessor Program output data and Section A. 3 gives 
a complete FORTRAN listing of the Preprocessor Program. For convenience, the 
NASA/MSFC Multilayer Diffusion Program is referred to as the Main Program in 
the following text. 

A. 1 PROGRAM INPUT PARAMETERS 


The Preprocessor Program requires the input of the following meteoro- 
logical parameters; 


°AR 


Standard deviation of the wind azimuth angle in de- 
grees measured at the first reference height over a 
10 -minute time period 
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p 


z 


e 

u 

T 

P 

RH 


Ambient air density in grams per cubic meter measured 
atz^ 

Height in feet or meters at which the meteorological 
measurements are taken 

Wind direction in degrees at z 

Wind speed in knots or meters per second at z 

Ambient air temperature in degrees Celsius at z 

Ambient air pressure in millibars at z 

Relative humidity in percent at z 


The Program also requires control information indicating: (1) vehicle 
type, (2) whether the computer run is for a normal or abnormal launch, (3) whether 
z is in feet or meters, (4) whether u is in knots or meters per second, (5) height 
of the surface mixing layer which must coincide with one of the z inputs above, and 
(6) the model being used and the pollutants for which data decks will be produced. 


A. 2 PROGRAM INPUT DATA CARD SEQUENCE 

The first card in the input data deck contains general case titling informa- 
tion and is used for a page heading in the Preprocessor print output and is also 
punched in the output data deck for input to the Multilayer Diffusion Program. The 

second input card contains control information and cr. „ and p at the surface. 

AR 

Data Card 1 ; 

Columns 1 - 72 - General data set titling information. If input as 
(NAMCAS) blankSjthe program will use the information input 

into the previous case processed. 
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Data Card 2; 


Column 1 
(NSPECL) 


Columns 2 
(VEHICL) 


Columns 5 
(N0RMAL) 


Column 8 
(IFEET) 

Column 9 
(KNOTS) 

Columns 10 
(DATE) 

Columns 40 
(TPR<2<P) 


Columns 46 
(SIGAR) 


Number of special data cards containing additional 
inputs to pass on to the Main Program This data 
is described under Data Card N + 2 to M (EXTR) 
below. The maximum value is 5. 

4 - Punch these characters indicating the vehicle type. 

If left blank Titan IIIC is assumed. 

TTN is the Titan HIC vehicle; 

STL is the ^ace Shuttle vehicle; 

DT2 is the.Delta-Thor 2914 vehicle; 

DT3 is the Delta- Thor 3914 vehicle; 

MIN is the Minuteman II vehicle. 

7 - Punch YES or leave blank if the run is for a nonnal 

launch. 

Punch N01 if the run is for an abnormal launch where 
a single engine burns on the launch pad. Not pro- 
duced for the Delta-Thor and Minuteman n vehicles . 
Punch N02 if the run is for an abnormal launch where 
a slow burn on the pad occurs. 

(0 is alphabetic) 

Punch M or leave blank if the heights z are in meters. 
Punch F if ihe heights are in feet. 

Punch M or leave blank if the wind speed u is in 
meters per second. 

•39 Punch the date of the meteorological case or any 

case identification information (optional). 

•45 * - Punch the initial temperature of the solid propellant 
in degrees F. If left blank, the average temperature 
at KSC for the indicated month is used. 

•51* - Punch cr._ 
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Data Card 2 (Continued) 


Columns 52 
(EHO) 

Columns 59 
(ZSP) 


Column 67 
(ISW(l)) 


Column 68 
(ISW(2)) 


Column 69 
(ISW<;3) ) 

Column 70 
(ISW(4) ) 

Column 71 
(ISW(5) ) 

Column 72 
(ISW(6) ) 


Coliunn 73 
(ISW(7)) 


58* - Punch p 


66* - Punch any special calculation height in the same 

units as z below. These columns are optional and 
if punch, this height and the surface height (o) are 
passed to the Main Program for calculations. 


Punch a 1 if output (dosage and concentration) for 
Model 4 is desired; leave blank if not. 

Punch a 2 if output for Model 5 is desired (precipi- 
tation deposition) using the Model 4 source and 
meteorological structure (HCl only). Punch a 3 if 
output (dosage and concentration) for Model 4 including 
depletion due to precipitation scavenging is desired. 


Punch a 1 if output (dosage and concentration) for 
Model 3 is desired; leave blank if not. 

Punch a 2 if output for Model 5 is desired using the 
Model 3 source and meteorological structure (HCl 
only). Punch a 3 if output (dosage and concentration) 
for Model 3 including depletion due to precipitation 
scavenging is desired. 


Punch a 1 if output for HCl is desired; leave blank 
if not. 


Punch a 1 if output for CO is desired; leave blank if 
not. (Not produced for Model 5). 

Punch a 1 if output for -^12^3 desired; leave blank 
if not. (Not produced for Model 5) . 


Punch a 1 if output for CO is desired; leave blank 
if not. Produced only for the Titan IIIC vehicle. 
(Not produced for Model 5). 


Punch a 1 if cloud the trajectory range and azimuth 
bearing are to be calculated and cloud rise time is to 
be printed; leave blank if not. 
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Data Card 2 (coatinued) 


Column 74 
(ISW(8)) 


Column 75 
(ISW(9)) 


Column 76 
(ISW(IO) ) 


Column 77 
(ISW(ll)) 


Column 78 
(ISW(12) ) 


Column 79 


Punch a 1 if the distribution of the source material 
in the layers is to have an elliptical shape. Leave 
blank if the distribution is to be spherical. 


Punch a 1 if column 67 or 68 is a 2 for Model 5 and 
oulput units in pH (surface water acidity) from the 
Main Program are desired. Leave blank if Model 
5 is to be in milligrams per square meter. (Option 
ISKIP(9) in Main Program). 

If left blank, the program provides for calculq.tions 
in the Main Program at the surface and at the special 
height specified in Columns 59-66 (if punched). 

Punch a 1 if Main Program calculations are to be 
performed at only the cloud rise height (H) and at the 
special height specified in Columns 59-66 (if punched). 
Punch a 2 if main model calculations are to be per- 
formed at the surface, the cloud rise height (H) and 
the special height specified in Columns 59-66 (if 
punched) . 


Punch a 1 if column 67 or 68 is a 2 and maximum 
possible precipitation deposition from Model 5 is 
desired. Leave blank if Model 5 is not being used or 
if the precipitation deposition from Model 5 is to be 
dependent upon the time of the start of precipitation. 
(Option ISKIP(4) in Main Program). 


Punch a 1 if concentration and dosage of precipita- 
tion deposition from the Main Program is to be 
printed for all calculation points. Leave blank if not. 
(Option ISKIP(l) in Main Program) 


Punch a 1 if maximum centerline concentration and 
maximum dosage or maximum centerline precipita- 
tion deposition, are to be printed by the Main Program. 
Punch a 2 for maximum centerline plots only. Punch 
a 8 for maximum centerline print and plot. (Option 
ISKIP(2) in Main Program). 
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Data Card 2 (continued ) 


Column 80 - Punch a 1 if isopleths of concentration and dosage 

(ISW(14) ) or precipitation deposition are to be printed by the 

Main Program. Punch a 2 if isopleth plots are only 
produced. Punch a 3 if isopleths are to be printed 
and plotted. (Option ISKIP(3) in Main Program). 

Data Card 3 ; (This data card is read only if colmnn 74 of data card 2 is 1). 

Column 1-4* - Punch the entrainment parameter for the alongwind 

(GAMMAX) dimension of the elliptically shaped cloud. If left 

blank, the program uses . 64 for a normal launch or 
. 5 for an abnormal launch. 

Punch the entrainment parameter for the crosswind 
dimension of the elliptically shaped cloud. If left 
blank the program uses . 64 for a normal launch or 
. 5 for an abnormal launch. 

Coliunn 9-12* - Punch the entrainment parameter for the vertical 

( GAMMAZ) dimension of the elliptically shaped cloud. If left 

blank the program uses . 64 for a normal launch or 
. 5 for an abnormal launch. 


Column 5-8* 
(GAMMAY) 


Data Card 4; 


Column 1-2 
(METUNT) 

Punch the Fortran logical unit number right justified 
from which the input data is to be read. If left blank, 
the program uses logical unit 5. 

Column 5-6 
(METDAT(l)) 

Punch the month of the meteorological data right 
justified. 

Colmnn 7-8 
(METDAT(2) ) 

Punch the day of the meteorological data right 
justified. 

Column 9-10 
(METDAT(3)) 

Punch the year of the meteorological data right 
justified. 
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Data Card 4 (contiaued ) 


Colvimn 13-14 - Punch the hour of the meteorological sounding right 

(NSND) justified (00-24). 


Column 17-18 - Punch the Fortran logical unit number for the output 

(I0UNT) data right justified. If 7 is punched, the output data 

is punched to cards. If left blank or 10 is pimched, 
the output data is written to mass storage random 
access unit 10 as a case inventory. Also, a directory 
of cases on unit 10 is written sequentially to tape or 
mass storage unit 12. It is the user' s responsibility 
to assign units 10 and 12. Unit 10 must be a mass 
storage file of at least 14 positions on the Univac 1108 
and unit 12 can be either mass storage or tape. These 
files can be temporary or permanent files and, if 
temporary, the Preprocessor and Main Program 
should be executed sequentially in the same run. 


Data Card 5; (This data card is read only if card column 67 or 68 on data card 2 
is greater than 1) . 


Column 1-10* - Punch the rainfall rate in inches per hour. If left 

(RAINRT) blank, the program uses 0. 3 inches per hour. 


Punch the rainfall scavenging coefficient in units of 
per second. If left blank, the program will calculate 

the scavenging coefficient using the following equation 

. 0.567 

scavenging coefficient = 5. 2xlO“^(R) 
where R is the rainfall rate in inches per hour 

Punch the time of the start of rain (seconds) after 
launch time. If left blank, zero is used. This para- 
meter is not used if maximum possible precipitation 
deposition is being calculated. 

Column 31-40* - Punch the maximum height in meters through which 

(ZLIM) precipitation can occur. If left blank, the program 

uses the height selected for the mixing layer height. 


Column 21-30* 
(TIMl) 


Column 11-20* - 
(LAMBDA) 
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Data Card 5 (continued) 


Column 41-50* - Punch the duration of the rain in hours. If left blank, 

(DURAT) the program uses 1 hour. This parameter is not 

used if maximum possible precipitation is being calr- 
culated. 


Data Card 6-N: (N must be less than or equal to 26). 

Column 1-10* - Punch the height of the layer boundary or sounding 

(Z) height 

Column 11-20* - Punch the wind direction in degrees. 

(WD) 


Column 21-30* - Punch the wind speed. 

(WS) 

Coliunn 31-40* - Punch the temperature in degrees Celsius. 

(T) 

Column 41-50* - Punch the pressure in millibars. 

(P) 


Column 51-60* - Punch the relative humidify in percent. 

(RH) 

Column 80 - Punch an asterisk (*) if the height on this card is 

(IHM) the surface mixing layer height If none of the data 

cards contains an asterisk, then the last height input 
is used as the suirface mixing layer height 

Data Card N + 1; 

Column 1-60: - This card signifies the end of the layer meteorological 

data on data cards 6-N by leaving columns 1-60 blank. 
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Data Card N + 1 (continued) 


Column 80: - Punch a 1 if this case is to be followed by another 

data case. Leave blank if this is the last data case 
for the Preprocessor to process. 

Data Card N + 2 - M: (These data cards are not read if column 1 on data card 2 

is blank or zero. Otherwise, M is the value in 'column 
1 on data card 2 plus N + 1), 


Column 1-80 - Punch data input variables in a namelist format for 

(EXTR) use in the Main Program that are not used or provided 

for in the Preprocessor. Any variable that can be 
input to the Main Program can be included in these 
data cards. The number of data cards is given in 
column 1 on data card 2. The program reads these 
cards and inserts them unaltered at the end of the 
preprocessor namelist output prior to the $END card. 
Any variable entered on these cards will override any 
equivalent variable produced by the preprocessor. 

The data items input are punched exactly as if they 
were to be included in an input namelist deck to the 
Main Program, except $NAM2 and $END cannot 
appear on these cards. For example, if the user 
wants to use a special grid system rather than the 
Main Program default grid system, the following 
data could be input beginning in column 2. MXS = 10, 
XX = 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000, 
10000, This input data would change the axis radial 
distances used in the Main Program calculations for 
this and subsequent case runs. If this input data is 
not to be used or if the default axis is to be used in 
subsequent cases these values must be changed in 
these cases to the desired values. Setting NXS = O 
in the next case would result in the default radial 
axis. 

♦Each of these fields is read using a format for real numbers. Except for data card 
3, the number punched in these fields must include a decimal point (period) unless 
it is a right justified whole number in the field. If the decimal point is omitted on 
data card 3, the two low order digits in each field are assumed to be the tenths and 
hundreths positions of the number. 
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A.3 


PREPROCESSOR PROGRAM OUTPUT 


The Preprocessor Program will produce a complete card deck for direct 
input to the NASA/MSFC Multilayer Diffusion Program — Version 6. The first card 
of each of the output data decks is a case identification card containing the vehicle 
type, date of sounding, and pollutant type. The second card contains $NAM2 and the 
last card of each case deck contains $END. A complete description of this entire 
deck is given in Section B. The possible data decks output are; 

Inputs for: 


(1) 

HCl 

- 

Model 4 

(2) 

CO 

- 

Model 4 

(3) 

“>2 

- 

Model 4 

(4) 

^2°3 

- 

Model 4 

(5) 

HCl 

- 

Model 3 

(6) 

CO 

- 

Model 3 

( 7 ) 

“>2 

- 

Model 3 

(8) 

^2°8 

- 

Model 3 

(9) 

HCl 


Model 5 and 4 

(10) 

MCI 

- 

Model 5 and 3 


A. 4 FORTRAN SOURCE LISTING FOR THE NASA/MSFC CLOUD-RISE PRE- 
PROCESSOR PROGRAM VERSION 6 

This section contains the complete FORTRAN source listing of the NASA/ 
MSFC Cloud-Rise Preprocessor Program — Version 6. 
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♦♦ 


1 * 

z* 

4* 

5 * 

6 * 

7* 


M 

CO 


8* 

9 * 

10 * 

11 * 

12 * 

13>tc 

14« 

15* 

164c 

17* 

18* 

19* 

20 * 

21 * 

22 * 

23* 

24* 

25* 

26* 

27* 

28* 

29* 

30* 

31* 

32* 

33* 

34* 

35* 

36* 

37* 

36* 


♦* NASA/MSFC CLOUD-RISE PREPROCESSOR PROGRAM - VERSION 6 

** 


program VHiCUEf VERSION 6, REVISION 0 

C ♦ plume rise and source distribution preprocessor program for use VHCOOlOO 

C * with the NASA/MSFC multilayer diffusion model - version 5a» VHC00200 

C * VHC00300 

C VHC00400 

C *»*«*«-#-*->4t«4t»*»*-*»'*-*-*“**»*-*-*-*-*-*-*-*-i*-*-i*-*-*-*«p*-*»»*-*-*“VHC00500 

C VHC00600 

COMMON /PLUME/ QC r A » B » C r HEAT » RHo » CP » PI » GAMMAX , GAMMA Y » GAMMaZ r T ( 21 ) r VHC00700 
lP(2l)»Z(21),UBAR(21)»NZSfO(20)»QTfHMfSIGEP{21)»SlGAP(21}»GrTAUKf VhCOOSOO 
2N0RMAL»TV(21),RH(21) »NAMCAS(12),NAMT(12)»SI6AR VHC00900 

COMMON /REST/ ZM»DPDZ»K»A1,B1»PhI1»ZP»TZ»PZ»PHI»IFLG»KS VHCOIOOO 

COMMON /SIG/ SIGX0(20) ,SIGYO(20) »SIGZO(20) rH VHCOUOO 

common /F/ DATE(6) fFR0(4 ) ,wTM0L(3) VHC01200 

dimension IPOL(4)»Il(160)»I2(12),I3(61),I4(13)»l5a42)rlTp(2),jP{2VHC01300 
1)»ISW(14) VHC01400 

dimension WS(21) » 16(44) »CC(8) VHC01500 

integer YES,VEHICL»TYPE»TYPES»UNITS VHC01600 

dimension TYPE(8) »GCl(8)fQTl(8) ,QC2(8) rQT2(8) »QC3(8) »QT3(8) »AA(8) » VHC01700 
1BB(8) »HEATN(8) »HEATA(8) fFRQl{4»8) »FR<52{4) rTYPES(15) fUNITS<4) » VHC01800 

2LNCH(11)»LNTL(8) ,HEATM(8) VHC01900 

dimension DDK10»4) »CCI(l0,4),TTl(10f4) VHC02000 

dimension DDIP(IO) VHC02100 

DmTa DDIP/I2.»l0,»8.»8,,4,,2.f4*0,/ VHC02200 

data TYPE/3hTTN,3HSTL»3HDT2»3HMiN»3HDT3»3*3H / VHC02300 

data QCl/5.437528E6fl.S267l702E7»8,360685E5»4.684476E5fl.057557E6»VHC02400 
13*0.0/ VHC02500 

Data QTl/3.2625l68E8rl,894794l73E9r2,887598E7»2.8l06856E7,6.702691VHC02600 
1E7»3*0,0/ VHC02700 

data QC2/2 . 718764E6 » 6 , 882968E6 r 9 . 098 1 1E4 » 4 , 684476E5 » 1 , 482923E5 , 3*0 VHC0280 0 
1,0/ VHC02900 

data QT2/i.6312584Efi»8.56929516E8r3,14229E6»2,8l06856E7»9,3986l6E6VHC03000 
1»3*0.0/ VHC03100 

data QC3/1.359382E6»3.441484E6»2.729434E5»l,171119E5,i,70731E5,3*OVHC03200 
1,0/ VHC03300 



^ 9 * 

40* 

41* 

42 * 

43 * 

44 * 

45 * 

46 * 

47» 

48 * 

49* 

b0« 

&!♦ 

b2» 

b3* 

b4« 

b&« 

b6« 

b7+ 

be# 

b9* 

60# 

61 # 

62# 

63# 

64* 

65 # 

66 # 

67 # 

66 # 

69# 

70# 

71# 

72# 

73# 

74# 

75# 

76# 


data QT3/3.2625l66E6»1.7l3659C32E9»l.S8b373E7»2.6l06856E7,4,699308VHC03400 
1E7»3#0,0/ VHC03500 

data AA/. 429580469, . 6522129891 , .922156, .469982 , 1 .245756 , 3*0 * 0/ VHC03600 

DaTa be/. 5184223, ,4680646, .4327u3» .463333, ,4180947,3*0.0/ 

DATa CC/5.0, .375, .54,5*0.0/ 

Data HEATiM/2021, 1,1479.7, 1766. 0,2055.9, 1449. 9, 3*0.0/ 
data HEATM/IOIC. 55, 1062. 35, 1000. 0,2055. 9, 1000.0, 3*0.0/ 

Data HEATA/2*1000,0»690,0,1000.U,411. 18 , 3 * 0 . 0 / 

FKAtTIONAL DIST FOR MINUTeMAN I I ABNORMAL LAUNCH 

Data FRQ2/. 2042109, .2188377, ,0» .2799764/ 

data FRQl/,1932, .2665, .0222, ,28l9, .1782, .2021, .0286, .2524, ,1218» VHC04400 

1.2055, .0156, .2214, .1977, .2380, .0318, .2761, .1589, .2783, .0331 » .1936, VHC04500 
212#0,0/ VHC04600 

data TYPES/90HTITAN HIC SPACE SHUTTLE DELTA-ThOR 2914 VHC04700 


VHC03700 

VHC03800 

VHC03900 

VHC04000 

VHC04100 

VHC04200 

VHC04300 

VHC04400 


VHC04800 
VHC04900 
SLOW BURVHC05000 
VHC05100 
VHC05200 


1 MlNUTEMAN H DELTA-THOR 3914 / 

data UNITS/24H PPM ML/M##3 / 

OaTa LNCH/68H NORMAL LAUNCHSINGLE ENGINE BURN 

invehicle / 

DaTa NAMT/12#1H / 

data CCI/i6.0,8.0,4.0,1.0,0,5,0.1,4#0.0,35.0,10.0,4.0,2.0,1.0,0.l»VHC05300 
14#0.0,20.0,i0,0,5.0*3.0,1.0»0,5,4#0.0,2.0»1.0,0.4,0.1,0,05f 0,01f4*VhC05400 
20.0/ VHC05500 

DaTa DDI/400. 0, 200. 0, 100. 0,50,0, 25. 0» 5. 0,4*0. 0,400. 0,200. Or 100.0, VHC05600 

150. 0. 25. 0.5.0. 4*0.0 >400. 0,200. 0,100.0, 50. 0,25. 0,5. 0,4*0. 0,40.0, VHC05700 

220. 0. 10. 0.5. 0.2. 5. 0.5. 4*0,0/ VHC05800 

data TTl/30.0,4.0,8.0,2,0,1.0,0.5,4#0.0,150.0,100.0r60,Or30,0,l5.0VHC05900 

1. 1.0. 4#0.0r5.0,2.0, 1.0, .5, .1, .05,4*0.0,50.0, 100.0,25,0, 10.0,5.0rl.VHC06000 

20,4*0.0/ VHC06100 

data JF/12H FEE! METERS/ ,N0/3h NO/ ,N01/3HN0l/ ,N02/3HN02/ VHC06200 

data YES/3HYES/,IPoL/24H HCL CO C02 AL203/, ITP/IHF, IHK/ VHC06300 

data IAST/Ih#/ VHC06400 

Data iblk/3h /,ibnk/ih /,nms/ihm/ vhco650o 

common /OUT/ OF(20,4) ,WD(21) rlSKlP(lO) ,NDI,NCI,NTl,ZRK»JBOT,sJTOPr VHC06600 
1UM0D(21) rCKlO) ,DI(10) ,TI(10) ,nPS VHC06700 

COMMON /PKECIP/ RAINRT, lambda, TIMI, ZLIM, DURAT, JSWS,EXTR(70) rNSPECLVhC06800 
COMMON/DISPl/ DXX,DX(21) ,OYYrUY(2l) ,ILXY,TIMC(21) VHC06900 

COMMON /CAScRD/ NVhCL , METQAT ( 3) , NMODL , NPLNT ,NSNpr lOUNT , lASV VHC07000 

dimension MeTDTC( 3) rAVTEMP(12) VHC07100 


77* 

78* 

79* 

80* 

» 1 * 

82« 

83* 

84* 

85* 

86* 

87* 

86* 

89* 

90* 

91* 

92* 

93* 

94* 

95* 

96* 

97* 

98* 

99* 

lUO* 

1U1» 

1U2* 

iU3* 

JiU4* 

iU5* 

106* 

107* 

1U8* 

109* 

110 * 

111 * 

112 * 

113* 

ll4* 


Rc.Al lambda VHC07200 

luTtGER EATR VHC07300 

DaTa l2ER0»iSTRTCfIfcNDC»lSTART/4*0/ VhC07400 

Data AVT£MP/69,9f67»26,69,57»74,19»78,33»81,81f63,06»83,55»82,45» VHC0750Q 
I79,32f73.1b»65,b2/ VHC07600 

equivalence (lBLK»8l-KS) VHC07700 

EQUIVALENCE ( WS» UBAH ) f (U » QC ) » ( l2f 2M) » ( I3 » S16X0) » VHC07800 

1U4,DATE) » (iSfQF) r (I6,LXX) VHC07900 

C VHC08000 

C ♦♦♦ PROGRAM INPUTS *** VHC08100 

C-OaTA card 1 VHC08200 

C NaMCAS - general OaTA set titling information (CARD 1 col 1-72) VHC08300 

IF INPUT AS blanks the information in The last case INPUVHC08400 


c 

c 

C-OATA CAhD 2 
NSPfcCL - 


IS used 


u 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


normal - 


number of special data Cards containing additional 
INPUTS Thai FOLLOa' the layer data variables under extr 
bElOw - iMAXlMUM OF 5, DEFAUlT=C) (CARD 2 COL 1) 

VEHICL - three characters GIVING THE VEHICLE TYPE (CARD 2 COL 
IS TITan IIIC vehicle (DEFAULT) 

IS SPACE Shuttle vehicle 

DELTA-ThoR 2914 VEHICLE 
MINUTEMaN 11 vehicle 

QELTA-THOR 3914 VEHICLE 

characters GIVING THE TYPE OF LAUNCH (CRD 2 COL 
iS A normal launch (DEFAULT) 

A SINGLE ENGINE BURN ABNORMAL LAUNCH 
A SLOW burn abnormal LAUNCH 
IFEtT - 1 CHAkAcTER IF Z IS IN FElT PcNCH Ft IF 2 IS IN M£TERS 
PUNCH M* (CARD 2 COL 8) (DEFAULTrM) 

KNOTS - 1 Character if ws is in meters/sec punch Mr if ws is in 
Knots punch k» (card 2 col 9) (default=m) 

DaTfc - 30 ChAkACTERS IDENTIFYING THE METEOROLOGICAL DATA CASE 

within The genlRal data case identified in NAMCAS above 

(CmRu 2 COL 10-39) 

TPROP - INI Hal TtHP£RATUR£ OF SOLID PROPELLANT (DEG F) 

(uEfault is Average temp, at ksc for that month if blank) 

(CARD 2 COL 40-4S, F6.C FORMAT) 


three 

TTn 

stl 

UT2 

MlN 

DTj 

three 

YES 
NOT 
NO 2 


IS 

is 

IS 


i.S 

IS 


VHC08500 
VHC08600 
VHC08700 
VHC08800 
VHC08900 
2-4)VHC09000 
VHC09100 
VHC09200 
VHC09300 
VHC09400 
VHC09500 
5-7)VHC09600 
VHC09700 
VHC09800 
VHC09900 
VHClOOOO 
VhClOlOO 
VHC10200 
VHC10300 
VhCl0400 
VHC10500 
VHC10600 
VHC10700 
VhClOSOO 
VhC10900 


il5» 

il6+ 

il7* 

ilb* 

a19* 

1^0* 

i'^1* 

I'tiZ* 

l23^ 

X'dH^ 

L'dt* 

I'dl* 

I'db* 

i, d9* 
i30# 
131* 

S 4^2* 
433* 
134^ 
i35» 
i36=f 
137+ 
i38* 

j, 39» 
x40* 

i‘+2* 

x43* 

144* 

i.45* 

i46« 

147* 

x48* 

449* 

XbOltl 

it>2^ 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


RHO - 
2SP - 


S16AR - standard deviation OF THE WIND AZIMUTH ANGLE AT ThE 

surface MEAi>UReMENT HEIGHT (DEGREES) (CARQ 2 cOL 46-51) 
(F6.0 FORMAT) 

SURFACE AIR DENSITY (G/M**3) (CARD 2 COL 52-58 F7*0 FORMAT) 

special Calculation height in addition to the surface 

HEIGHT IN THE SAME UNITS AS Z BELOW (CARD 2 COL 59-66) 

(F8.0 FORMAT) 

ISW(l) - IF SET TO i calculate PARAMETERS FOR MqDeL 
if set to 2 calculate PARAMETERS FOR MODEL 

IN conjunction With model 5 - (data card 5 

DUS OPTION) 


4 

H and use 
IS read with 


VHCllOOO 
VHClUOO 
VHC11200 
VHCU300 
VHC11400 
VHC11500 
VHCU600 
VHC11700 
VHC11800 
VHC 11900 
VHC12000 


model 5 IS The precipitation deposition model (See isw(9)vhci2ioo 


3 and use 
is read with 


aNj iSw(U) AND DATA CARD 5 

IF SET TO 3 calculate PARAMETERS FOR MODEL 4 AS IF 1 BUT 
ALSO INPUT CARD UNIT 5 TO CALCULATE CONCENTRATION AND 
DOSAGE with DEPLETION DUE TO PRECIPITATION SCAVENGING 
IF set TO 0 MODEL 4 IS NOT PRODUCED (CaRD 2 COL 67) 
ISW(2) - IF Set to 1 calculate parameters FOR MODEL 3 

IF set to 2 CALCULATE PARAMETERS FOR MODEL 

IN conjunction With model 5 - (data card 5 

THIS OPTION) 

IF set to 3 CALCULATE PARAMETERS FOR MODEL 3 AS IF I » 
ALSO INPUT CARD UNIT 5 TO CALCULATE CONCENTRATION AND 
DOSAGE with depletion DUE TO PRECIPITATION SCAVENGING 
IF set to 0 MODEL 3 IS NOT PRODUCED (CaRQ 2 COL 68) 
ISW(3) - IF SET TO 1 DATA FOR HcL IS PRODUCED 

IF SET TO 0 HCL ISNOT PRODUCED (CARD 2 COL 69) 

iSw(4) - IF SET TO 1 data FOR CO IS PRODUCED 


IF set TO 0 CO IS NOT PRODUCED (CARD 2 COL 70) 

ISrt(5) - IF SET TO 1 data fOR AL203 IS PRODUCED 

IF SET TO 0 AL203 IS NqT PRODUCED (CARD 2 COL 71) 

ISW(6) - IF set to 1 DATA FOR Co2 IS PRODUCED 

IF set to 0 C02 IS NOT PRODUCED (CARD 2 COL 72) 

iSW(7) - IF StT TO 1 THE CLOUD TRaUECTORY COORDINATES DELXrDELY 
ARE CALCULATED And PUNCHED FOR EACH LAYER, IF SET TO ( 

CLOUD TRAJECTORY COORDINATES ARE NOT CALCULATED 
ALSO, layer cloud RISE TIME IS CALCULATED (CARD 2 COL 73)VhC14600 
ISW(8) - IF set to 1 the program USES AN ELLIPTICAL SHAPE RATheR VHC14700 


VHC12200 
VHC12300 
VHC12400 
VHC12500 
VHC12600 
VHC12700 
VHC12800 
VHC12900 
VHC13000 
BUTVHC13100 
VHC13200 
VHC13300 
VHC13400 
VhCl3500 
VHC 13600 
VhCl3700 
VHC13800 
VHC 13900 
VHC14000 
VHC14100 
VHC14200 
VhC14300 
VHC14400 
VHC14500 



it)3» 

ibS* 

mb* 

mi* 

m&* 

ib9* 

ibO* 

lbl« 

mz* 

mi* 

lb4* 
lb5* 
ib6* 
ib7* 
ib8* 
m9* 
i/0* 
171* 
i7Z* 
l7i* 
i74* 
i/5* 
i/b* 
177* 
it 8* 
l79* 
ibO« 

mz* 

mi* 

iti4» 

mb* 

mb* 

m7* 

mb* 

m9* 

ivo* 


than a spherical shape to determine the distribution of VHC14800 
material in the Layers, (caRw z col 74) vhci490o 

ibW{9) - THIS Parameter is used only if iswU) oR isw(2) equals 2.vhci5ooo 
IF ibA'(9) = 0 the output units of precipitation VhClSlOO 

deposition will be M6/M**2. IF ISW{9) = 1 THE UNITS WILL VHC15200 
BE PH FOR HCL ONLY. (CaRO 2 COL 75) VHC15300 

ISW(IO)^ IF SET TO 0 THE PROGRAM PROVIDES FOR SURFACE CALCULATIONSVHC15400 
only OR IF 2SP IS INPUT AT THE SURFACE AND ZSP. VHC15500 

IF SET TO 1 THE PROGRAM PROVIDES FOR CALCULATIONS AT THE VHC15600 
cloud rise HEIGHT H AND AT ZSP IF INPUT VHC15700 

IF SET TO 2 the program PROVIDES FOR CALCULATIONS AT THE VHC15800 
SURFACE f the CLOUD RISE HEIGHT H AND AT ISP IF INPUT VHC15900 
(Card 2 col 76) VHCieooo 

ISW(ll)- THIS parameter IS USED ONLY IF ISW(l) OR ISW(2) EQUALS 2»VHC16100 
IF ISrt(U) IS SET = If THE MAXIMUM POSSIBLE GROUND-LEVEL VHC16200 
PRECIPITATION DEPOSITION IS CALCULATED. THE CALCULATIONS VHC16300 


C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

^»l 

L 

c 
c 
c 
c 
c 

C-DATA card 3 (READ ONLY IF ISW(6) IS NON-ZERO) 

C THE following PARAMETERS ON CARD if GAMMAX»GAMMaY»6AMMAZ aLL USE 


aR£ independent of The time precipitation begins, 

IF ISW(U) IS SET = Of the PRECIPITATION DEPOSITION IS 
DEPENDENT UPON THE TIME OF START OF PRECIPITATION. 
(Card 2 col 77) 

ISW(12) - IF > 0 PRINT all GRID CALCULATIONS OF CONCENTRATlONf 
DOSAGEf DEPOSiTlONf ETC. FROM MAIN MODEL. (DEFAULT=0) 
( CARD 2 COL 78) 

ISW(13) - IF > 0 CALC, maximum CENTERLINE VALUES OF 
DuSAGEf DEPOSiTiONf ETC, FROM MAIN MODEL. 

IF = 1 values are printed only 

IF = 2 values are plotted Only 

IF = 3 values are both PRINTED AND PLOTTED 

(CARD 2 COL 79) 

ISWa**) - IF > 0 CALC. ISOPLETHS OF CONCENTRATION, DOSAGE, 
DEPOSIT ION f ETC. FROM MAIN MODEL. f 
IF = 1 values ARE PRINTED ONLY. 

IF = 2 Values are plotted only 

IF = 3 VALUlS are both PRINTED AND PLOTTED 

(CARD 2 cOL BO) 


VHC16400 
VHC16500 
VHC16600 
VHC16700 
VHC16800 
VHC16900 
VHC17000 
CONCENTRATIONVHC17100 
VHC17200 


VHC17300 

VHC17400 

VHC17500 

VHC17600 

VHC17700 

VHC17800 

VHC17900 

VHC18000 

VHC18100 

VHC18200 

VHC18300 

VHC18400 

VHC18500 



iVl* 

1^2* 

193* 

i94* 

i95* 

iV6* 

i97* 

X98* 

199* 

^UQ>K 

<:01* 

2U2« 

203* 

2U4« 

2U5* 

2U6* 

2(J7* 

2U6>«c 

t09* 

210* 

211 « 

212 « 

213« 

2XH« 

21S+ 

2164c 

217# 

218« 

2194c 

<:204c 

221’«‘ 

^22« 

2234= 

^244= 

2254c 

<:264c 

2274= 

228 >^ 


C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C-DATA 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


AN F4,2 format, also# THIS CARD IS NOT READ IF lSrt(8)=0. ALSO# VHC18600 
THE default value pUR EACH PARAMETER IS .64 FOR A NORMAL LAUNCH VHC18700 
AlviD .5 FOR an AdNORMAL LAUNCH, ALSO# THE PRODUCT OF ALL THREE VHC18800 

Parameters must equal (,64)4=*3 for a normal launch or if abnormal vhci89oo 
GaMmAX4=GAMMaY must equal 10,5)4.4=2 VHC19000 


GAMmAX - ENTRAIwMENT parameter for the X OR ALONG#^INQ DIMENSION 
FOR AN ELlIPTICALLY SHaPED CLOUD (ISW(8)=1 ONLY) 

(Card 3 COL 1-4) (USE DEFAULT FOR DELTa-THOR) 

GaMmAY - ENTRAH4MENT PARAMETER FOR THE Y OR CROSSWINO DIMENSION 
for an ELLIPTICAlLY shaped cloud (lSW(8)=i ONLY) 

(Card 3 COL 5-8) (USE default for DELTa-THOR) 

GAMmAZ - entrainment parameter for the z or vertical dimension 

for an ELLIPTICALLY SHAPED CLOUD (ISW(8)=1 ONLY) 

(Card o col 9-12) (USE DEFAULT FOR DELTA-THOR) 

CARD 4 

MfcTuNT - FORTRAN UNIT FROM WHICH TO READ MET. DaTa 
DEFAULT = 5 CARD DATA, 

METdAT(I) - MONTH oF MET, QATa (CARD 4 COL 5-6) 

METUAT(2) - DAY OF MET, DATA (CaRO 4 COL 7-8) 

METuAT(3) - YEAR OF MET, DATA (CARD 4 COL 9-10) 

NSNu - HOUR OF SOUNDING (0-24) (CARD 4 COL 13-14) 

iount - fortran unit where punch out is to be Sent 


VHC19100 
VHC19200 
VHC19300 
VHC19400 
VHC19500 
VHC19600 
VHC19700 
VHC19800 
VHC19900 
VHC20000 
(CARD 4 COL1-2)VHC20100 
VHC20200 
VHC20300 
VHC20400 
VHC20500 
VHC20600 
(CARDS OR TAPE)VHC20700 


(CARD 4 COL 17-18) (DEFAULT = 10 MASS STORAGE UNIT 10) VHC20800 
IF lOUNT = 10 THE program REQUIRES MASS STORAGE LOGICAL VHC20900 
UimIT 10 AND tape OR MaSS STORAGE LOGICAL UNIT 12, UNIT VHC21000 
12 CONTAINS The DIRECTORY INFORMATION FqR EACH CASE AND VHC21100 
UNIT 10 contains THE CASE DATA CARD INFORMATION IN A CARD VHC21200 


image format for namelist input. VHC21300 
C-DATA card 5 (REmO ONLY IF ISW(l) OR ISW(2) EQUALS 2 OR 3) VHC21400 
C RAInRT - KAlNFAuL RATE FOR PRECIPITATION DEPOSITION (MODEL 5) VHC21500 
C (Card 5 COL 1-10) in units of inches per HOUR, VHC21600 
C (F10,0 FORMAT), (DEFAULT = 0,3 INCHES/HOUR) VHC2170Q 
C LmMbDA - rainfall SCAVENGING COEFFICIENT (CARD 5 COL 11-20) IF VHC21800 
C ZERO OR blank lambda IS CALCULATED FROM RAINRT, VHC21900 
C (FlO.O FORMAT) VHC22000 
C TlNU - TIME IIM seconds OF START OF RAIN (CARD 5 COL 21-30), TIMI VHC22100 
C IS measured from LAUNCH TIME AND IS USED ONLY IF ISW(II) VHC22200 
C above is set to 0. (FlO.O FORMAT) (DEFAULT = 0,0) VHC22300 


ZZ9* 

k^6* 

257* 

«;5e« 

k39* 

k**0* 

lc>*l* 

k^tz* 

k^3* 

k‘*‘** 

245* 

246* 

247* 

246* 

249* 

2bO« 

2bl* 

kbk* 

2b3« 

2b4* 

2b5* 

2b6« 

2b7* 

2b6« 

2b9* 

2bO« 

2bl« 

2b2* 

2b3* 

2b4* 

<b5» 


c 

c 

c 

c 

c 

c 


ZLiM • MAXIMUM HEIGHT THROUGH WHICH PRECIPITATION CAN OCCUR* 

(CARD 5 COL, 31-40 plO.O FORMAT), (DEFAULT = THE HEIGHT 

Elected for the surface mixing layer height hm) 

(UNITS ARE THE SAME AS Z BELOW) 

DURaT - duration OF RAIN IN H0URS» USED ONLY IF ISWUl) s 0, 
(DEFAULT = I HR) (CARD 5 COL 41-50 FlO.O FORMAT) 


THE FOLLOWING PARAMETERS EXCEPT IHM ALL USE AN FlO.O FORMAT 

- . ^ ip% k i mm 4^ rnmm JA» % J"*w I 4 4 


C-DATA CARDS 6-N 
C 
C 
C 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 


HEIGHT OF layer BOUNDARIES (FEET OR METERS) COL I-IO 
WIND DIRECTION AT EACH Z (DEGREES) COL 11-20 
WIND SPEED AT EACH Z (KNOTS OB METERS/SEC) COL 21-30 
temperature at each Z (DEGREES C) COL 31-40 
pressure at EACH Z (MILLIBARS) COL 41-50 
relative humidity at each Z (PERCENT) COL 51-60 
IhM - asterisk (♦) IN COLUMN 80 IF THE HEIGHT Z ON THIS CaRO IS 
THE SURFACE MIXING LAYER HEIGHT HM, IF NOT FOUND THE LAST 2 
IS USED FOR HM, 


Z 

WD 

WS 

T 

P 

RH 


VHC22400 
VHC22500 
VHC22600 
VHC22700 
VHC22800 
VHC22900 
VHC23000 
VHC23100 
VHC23200 
VHC23300 
VHC23400 
VHC23500 
VHC23600 
VHC23700 
VHC23800 
1NPUTVHC23900 
VHC24000 


Twr haTa CA«n That SIGNIFIES THE END OF THE LAYER MET DATA IS ALL VHC24100 
blank EXCEPT FOR COL 60, IF COL 80 IS NON-BLANK THE PROG EXPECTS VHC24200 
another COMPLETE DaTA CASE TO FOLLOW. IF BLANK THE PROG ASSUMES 
END OF data AFTER THE NEXT TWO CARDS. 


V WtlW Vr I n nr « U.» ' I * > I*-*' -L«r-*rr-n. 

C-DATA card N+2 to N+1+NSPECL (THESE nSPECL DATA CARDS ARE READ AFTER 


C 

C 

C 

C 

C 

C 

C 

c 

c 

C 

c 

C 

c 

c 

C 

C 


VHC24300 

VMC24400 

VHC24500 

VHC24600 

VHC24700 


the CARO That signifies the end of the layer met data, 

(NSPECL CARl)S» col 1-80» 13a6»A2 FORMAT PER CaRO) - 

EXTR - array of a MAXIMUM OF 40q CHARACTERS, THIS ARRAY IS USED ’^°)(^J24800 
INPUT data variables FOR USE IN THE MAIN MULTILAYER MODEL yHC24900 
that are NOT USED IN THE PREPROCESSOR. ThE PROGRAM READS VHC25000 
THIS array aNO inserts it into the preprocessor punch ^^^25100 

OUTPUT, any variable ENTERED INTO THIS ARRaY WILL OVERRIDE yHC25200 
THE equivalent VALUE PRODUCED BY THE PREPROCESSOR. THE 

data items input into the array £XTr are Punched exactly 

AS IF THEY were TO BE INCUUDED IN AN INPUT NAMELIST OE« TOVHC|5500 


THE MAIN moose EXCEPT TH£Y CANNOT INCLUDE $NAM2 OR SEND, 
EXAMPLE - IF 'Wt WANT TO USE A SPECIAL GRID SYSTEM RATHER 
than the main model DEFAULT WE WOULD INPUT THE FOLLOWING 

data begining in col 2. ^ 

NXSsiO.XxrlOOO, 2000 >3000,4000 *5000, 6000 *7000 *8000 *9000, 

lOOOu, 


VHC25600 

VHC2S700 

VHC25800 

VHC25900 

VHC26000 

VHC26100 



2b7* 

2b9* 
2 70* 
dll* 
did* 
dli* 
dl>4* 
di5* 
dlb* 
dll* 

die* 

di9* 

d60* 

del* 

dez* 

des* 

den* 

des* 

deb* 

dei* 

^b8>tc 

d69* 

290* 

291* 

292* 

293* 

294* 

295* 

296* 

297* 

298« 

299* 

300* 

301* 

302>*c 

303* 

304* 


C 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


this data would change the axis radial distances to these VHC26200 

NEW VALUES pOR THIS CASE RUN. IF SUBSEQUENT CASES ARE NOT VHC26300 

GOING TO USE These values or if the default axis is to be VHC26400 
USED THESE VALUES MUST BE CHANGED TO THE DESIRED VALUES OR VHC26500 
NXS must be set TO 0 ON THE NEXT CASE TO GET THE DEFAULT AXVHC26600 


IF NSPECL IS 0 THIS DATA CARO(S) IS NOT READ 
INITIALIZE CORE TO ZERO 


VHC26700 

VHC26800 

VHC26900 


5 DO 10 

1=1 » 161 


VHC27000 

U(I) 

= 0 


VHC27100 

IF (I 

,GT, 142) 

GO TO 10 

VHC27200 

Io(X) 

= 0 


VHC27300 

IF il 

*GT. 61) 

GO TO 10 

VHC27400 

I>i(I) 

= 0 


VHC27500 

IF (I 

.GT, 44) 

GO TO 10 

VHC27600 

Ib(I) 

= 0 


VHC27700 

IF (I 

•GT. 12) 

GO TO 10 

VHC27800 

12(1) 

= 0 


VHC27900 

IF (I 

t GT . 13 ) 

GO TO 10 

VHC28000 

I*+(I) 

= 0 


VHC28100 

10 continue 


VHC28200 




VHC28300 


*** 

program constants 

VHC28400 


QCI-TOTaL SOURCE OUTPUT RATE IN GRAMS/SEC FOR A NORMAL LAUNCH VHC2B500 
QTl- TOTAL SOURCE STRENGTH IN GRAMS FOR NORMAL LAUNCH VHC28600 

QC2 - total SOURCE OUTPUT RATE IN GRAMS/SEC FOR AN ABNORMAL LAUNCHVHC28700 
with one engine BURNING ON PAD VHC28800 

QT2 - TOTAL' SOURCE STRENGTH IN GRAMS FOR AN ABNORMAL LAUNCH WITH VHC2B900 
ONE engine burning ON PaD VHC29000 

QC3 ^ total source OUTPUT RATE IN GRAMS/SEC FOR AN ABNORMAL LAUNCHVHC29100 
where engines explode and BURN ON GROUND VHC29200 

QT3 - total SOURCE STRENGTH IN gRAMS FOR AN ABNORMAL LAUNCH WHERE VHC29300 
THE ENGINES EXPLODE AND BURN ON GROUND VHC29400 

AA and BB - ROCKET RISE PARAMETERS IN EQUATION TR=AA*Z**BB VHC29500 

HEATN - HEAT OUTPUT (CAL/G) NORMAL LAUNCH VHC29600 

HEATM - HEAT OUTPUT (CAL/G) ABNORMAL LAUNCH WITH SINGLE ENGINE VHC29700 
BURN VHC29800 

HEATA - HEAT OUTPUT (CAL/G) ABNORMAL LAUNCH WITH SLOW BURN ON PAD VHC29900 



505* 

C 

GAMMAI - tNTRAlNMENT PARAMETER pOR 

NORMAL Launch 

VHC30000 



gamma I =0.64 


VHC30100 

307* 

c 

gmmmac - entrainment parameter pOR 

ABNORMAL LAUNCH 

VHC30200 

308* 


GAMMAC =0,5 


VHC30300 

^09* 


GaMmAX =0,0 


VHC30400 



gamma Y =0,0 


VHC30500 

^11* 


GAMMAZ =0.0 


VHC30600 


c 

PHQ - PRACTIONAL DISTRIBUTION Op MATERIAL FOR HCUr CO, C02, AL203 

VHC30700 

m* 

c 

WTMOL - MOLECULAR VjLIGHTS OP HCL» ( 

:o, C02 

VHC30B00 



WTMoL(l) = 36,46 


VHC30900 



WTMuL(Z) = 28,01 


VHC31000 

Jl6« 


WTM0L(3) = 44,01 


VHC31100 

in* 

c 

G - acceleration of GRAVITY (M/SEC 

SQUARE) 

VHC31200 

ilB* 


G = 9.8 


VHC31300 

^19* 

c 

CP - SPECIFIC HEAT OP AIR 


VHC31400 

520>l> 


CP = 0,24 


VHC31500 

iZl* 

c 

Pi - radians in 180 degrees 


VHC31600 

iZZ* 


PI = 3,1415926 


VHC31700 

5^^* 


Nul = 69 


VHC31800 



NCI = 69 


VHC31900 

iZ5* 


00 12 I=1»10 


VHC32000 

iZb* 


12 ISKIP(I) = 0 


VHC32100 

iZ7* 


NPS = 0 


VHC32200 

iZB* 

c 



VHC32300 

iZ9* 

c 

♦♦ CARD 1 


VhC32400 

iiO* 


READ 1002, NAMCAS 


VHC32500 

ai* 


00 15 1=1,12 


VHC32600 

iiZ* 


IF (NAMCAS(I) ,NE. IBLK) GO TO l7 


VHC32700 

as* 


15 continue 


VHC32800 

BM* 


00 16 1=1,12 


VHC32900 

as* 


16 NAMcAS(I) = NAMT(I) 


VHC33000 

Bib* 


17 DO 18 I=1»12 


VHC33100 

BB7* 


18 NAMT(l) = NaMCASU) 


VHC33200 

BB&* 

c 



VHC 33300 

H9* 

c 

♦♦ CARD 2 


VHC33400 

B‘^0* 


READ 1000 » NSPECL » VEHICL » NORMAL , IPEET , KNOTS , ( DATE (I ) » 1=1 » 5 ) » TPROP 

»VHC33500 

34i* 


isigar*Rho,zsp»isw 


VHC33600 

542* 


IF (ISW(12) ,GT, 0) ISKIPU) = ISW{12) 

VHC33700 




llr (ISV^(13) ,3T, 0) I5KIP(2) = ISW(13) 

VHC33800 

344* 


IF (ISW(14) .GT. 0) ISKIP(3) = 1SW(14) 

VHC33900 

345* 

C 


VHC34000 

346* 

C 

** CARD 3 (OPTIONAL) 

VHC34100 

347* 


IF (ISVv(8) ,EO. 1) read lOObf 6 aMM AX r GAMMA Y » GAMMA2 

VHC34200 

348* 

C 


VHC34300 

349* 

c 

** CARD 4 

VHC34400 

330* 


RtAU 1003# METUNT# (METDAT(I) #1=1,3) fNSNDrIOUNT 

VHC34500 

331* 


IF (METUNT .EQ. 0) METUNT = 5 

VHC34600 

332* 


IF (IOUNT .EQ. 0) lOUNT = 10 

VHC34700 

333* 


K = 1 

VHC34800 

334* 

c 


VHC34900 

Ci35* 

c 

IF namelist is to b£ OUTPUT TO CARDS (UNIT 7)# BRANCH 

VHC35000 

o36* 


IF (IOUNT .EQ, 7) GO TO 24 

VHC35100 

337* 

c 


VHC35200 

338* 

c 

IF This# ISN’T THE FIRST TIME THROUGH# BRANCH 

VHC35300 

339* 


IF (ISTART ,NE. 0) GO TO 24 

VHC35400 

3b0* 


DEFINE FILE 10(100000#60#L#IASV) 

VHC36000 

3bl* 


ISTaRT = 1 

VHC36100 

3b2* 

c 


VHC36200 

3b3* 

c**** 

*VHC36300 

3b4* 

c 

special code to include ^hen no master file for 

VHC36400 

3b5* 

c 

namelist and directory are used (I.E.# NO TAPE COPIED) 

VHC36500 

3b6* 

c 


VHC36600 

3b7* 


write (12,2012) (IZ£R0#I=1#9) 

VHC36700 

3b8* 

c 


VHC36800 

3b9* 


END FILE 12 

VHC36900 

370* 


End FILE 12 

VHC37000 

371* 


REWIND 12 

VHC37100 

372* 

t 


VHC37200 

373* 

c**** 

*VHC37300 

374* 

c 

READ Through directory for the end of file indicatoR(IZero) 

VHC37400 

375* 


19 ISTkT = istrtc 

VHC37500 

376* 


IEND = lENDc 

VHC37600 

377* 


RtAo (12,2012) NVHCLC# (METDTC(J) #J=1#3 ) ,NSNDC#NmOqLC#NPLNTC» 

VHC37700 

378* 


1ISTkTC»IENDC 

VHC37800 

379* 


IF (NVHCLC .N£, IZERO) 60 TO 19 

VHC37900 

3«0* 

c 

POSITION 12 for next ENTRY 

VHC38000 


obi* 


BACKSPACE 12 

VHC36100 

ob2* 

C 

POSITION 10 for next namelist set 

VHC38200 

ob3* 


lASv = IENO+1 

VHC38300 

3ti4* 

C 


VHC38400 

0b5* 


ItRR = 0 

VHC36500 

3bb* 


IF (METUNT ,E0. 5) eO TO 24 

VHC38600 

Ob7* 

C 


VHC38700 

ObB* 

cc 

call METIN(IERR) - FOR READING FROM MET. TAPE 

VHC38800 

3b9* 

c 


VHC38900 

39b* 


IF (lERR ,Eu, 0) 60 TO 22 

VHC39000 

o91* 

c 

ERROR IN READING Mt.T, TAPE 

VHC39100 

092* 


24 IF (JSWS .GT. 0,AND«LAMBDA .LE. 0,0) OStoS z 0 

VHC39200 

093* 


TlMl =0,0 

VHC39300 

094* 


LaMdDA =0.0 

VHC39400 

095* 


RmInRT =0.0 

VHC39500 

096* 


ZLIM = 0.0 

VHC39600 

o97* 


DOHaT =0.0 

VHC39700 

096* 


IF (ISkid) .LT. 2 .aND.ISW(2) .LT, 2) 60 TO 20 

VHC39800 

099* 

c 


VHC39900 

hOO* 

c 

** CARD 5 (OPTIoNmL) 

VHC40000 

4U1* 


REAL 1001» KAiNRT»LAMLDAfTlMl,ZLlM»DURAT 

VHC40100 

hU2* 

c 


VHC40200 

4U3* 

c 

** CARD 6 through N+1 

VHC40300 

4b4* 


20 Read 1001» Z(^)»Wy(K)»'^S(^),T(K)»P(K)^RH(K)^IHM 

VHC40400 

4U5* 


IF (IhM .£0. IAST) HM = Z(K) 

VHC40500 

>tU6* 

c 

MAKt SURE Thai R does not exceed its range (20 VAuUES, 

PLUS 1 FOR VHC40600 

407* 

c 

work SPACfc) 

VHC40700 

408* 


IF (K .UT. 21) GO TO 23 

VHC40800 

409* 


K = K-1 

VHC40900 

410* 


IF lIHM .EO, iAST) HM = Z(K) 

VHC41000 

4ll* 


IF (Z(K+1)+I«S(K+1) ) 21.28,21 

VHC41100 

412* 


c6 CONTINUE 

VHC41200 

413* 


K = K+1 

VHC41300 

414* 


Go TO 22 

VHC41400 

415* 


23 CONTINUE 

VHC41500 

416* 


IF (Z(K)+*S(K)) 21,22,21 

VHC41600 

‘fl7* 


21 K = K+1 

VHC41700 

416* 


GO TO 20 

VHC41800 



Hl9* 


22 

N4S = K-1 

VHC41900 

4^0* 

C 



VHC42000 

421* 

C 

compote burn RaTc factor due to initial propellant 

TEMPERATURE VHC42100 

422* 

C 



VHC42200 

423* 



IMOnTH = METDaTU) 

VHC42300 

424* 



RFACT =1,0 

VHC42400 

425* 



IF (IMONTH ,E0, 0) 00 TO 27 

VHC42500 

426* 



IF (TPPOP-0,0) 26r2&»26 

VHC42600 

427* 


25 

TPROP = AVTeMP(IMONTH) 

VHC42700 

428* 


26 

RFACT = 0,00l*(TPROP-70,0)+1.0 

VHC42800 

429* 


27 

continue 

VHC42900 

430* 



SIGaPU) = 0.5*SI0AR 

VHC43000 

431* 



IPNPS = 4 

VHC43100 

432* 



IF (ISW(5) .GT. 0)GO TO 30 

VHC43200 

433* 



IPNPS = 3 

VHC43300 

434* 



IF (ISW(6) .GT, 0)GO to 30 

VHC43400 

435* 



IPNPS = 2 

VHC43500 

436* 



IF (ISW(4) .GT, 0) 60 TO 30 

VHC43600 

437* 



IPNPS = 1 

VHC43700 

438* 


30 

continue 

VHC43600 

h39* 

C 

** CARD N+2 TO N+1+nSPECL 

VHC43900 

440* 



IF (NSPECL ,LE, 0) 60 TO 38 

VHC44000 

h41* 



J = NSPECu*l4 

VHC44100 

442* 



READ 1002, (EXTR(I)»I=1»J) 

VHC44200 

443* 


38 

CONTINUE 

VHC44300 

h44* 

C 


2RK - height AT WHICH SIGAR IS MEASURED (METERS) 

VHC44400 

445* 



ZKK = 2(1) 

VHC44500 

446* 



IF (NORMAL ,EQ, IBLK) NORMAL = YES 

VHC44600 

447* 



IF (VEHICL .£0, TYPfc(l)) 60 TO 40 

VHC44700 

448* 



IF (VEHICL ,EQ, TYPE(2)) 60 TO 41 

VHC44800 

449* 



IF (VEHICL ,EO, TYPE(3)) GO TO 42 

VHC44900 

4b0* 



IF (VEHICL ,EQ, TYpL(4)) GO TO 43 

VHC45000 

4bl* 



IF (VEHICC ,E0, TYPE(5)) 60 TO 44 

VHC45100 

h52* 



print 2009 

VHC45200 

Hb3* 


40 

JV = 1 

VHC45300 

4b4* 



GO TO 50 

VHC45400 

4b5* 


41 

Jv = 2 

VHC45500 

Hb6* 



ISW(6) = 0 

VHC45600 


4b7* 


TO 50 




4b8« 

42 

JV = 3 




4b9* 


ISW(6) = 0 




4bO)K 


IF (NORMAL ,E&, NOD 

normal 


N02 

4bl* 


GO TO 50 




4b2* 

43 

UV = 4 




4b3>«< 


IbW(b) = 0 




4b4* 


IF (NORMAL ,EQ, NOD 

normal 


N02 

4b5* 


GO TO 50 




4bb* 

44 

JV = 5 




4b7* 


I5W(6) = 0 




4b6* 


IF (NORMAL .EQ. NOD 

normal 

= 

N02 

4b9* 

50 

IF (JV ,NE, 4) 00 TO 

51 



470* 


IF (NORMAL ,Nt. YES) 

60 TO 

53 


471* 

51 

DO 52 Islf4 




472» 

52 

FKQ(I) = FROKIfJV) 




473* 


GO TO 55 




474* 

53 

DO 54 I=lr4 




475* 

54 

FRQ(I) = FR02(I) 




‘+76* 

55 

CONTINUE 




477* 


IF (IFEET .to, IBNK) 

IFEET 

= 1 

NMS 

478* 


IF (KNOTS .to. IBNK) 

KNOTS 

= 1 

NMS 

479* 


IF (NORMAL ,E0. YES) 

60 TO 

63 


480* 


IF (NORMAL ,E0, NOD 

GO To 

61 


4bl* 


IF (NORMAL ,E0* N02) 

GO TO 

60 


482* 


print 2006, normal 




483* 


GO TO 500 




484* 

60 

QC = 0C3(JV)*RFACT 




488* 


Of = 0T3(JV) 




4bb* 


IwiM = 7 




487* 


HEAT = HEATa(jV) 




486* 


ISKIP(6) = 4 




489* 


60 TO 62 




490* 

61 

QC = QC2( jV)»RFACT 




491* 


QT = QT2(JV) 




492* 


IJM = 4 




493* 


HEAT = HEATM(oV) 




494* 


ISKiP(6) = 3 





VHC45700 

VHC45800 

VhC45900 

VHC4600Q 

VHQ46100 

VHC46200 

VHC46300 

VHC46400 

VHC46500 

VHC46600 

VHC46700 

VHC46800 

VHC46900 

VHC47000 

VHC47100 

VHC47200 

VHC47300 

VHC47400 

VHC47500 

VhC47600 

VHC47700 

VHC47800 

VHC47900 

VHC48000 

VHC46100 

VHC46200 

VHC48300 

VHC46400 

VHC48500 

VHC48600 

VHC46700 

VHC48800 

VHC46900 

VhC49000 

VHC49100 

VHC49200 

VHC49300 

VHC49400 



495* 

t>2 

NuRjviAL s 0 


VHC49500 

496* 


If- (6AMMAX ,Lt;. 0,0) OAMMaX 

= GaMMAC 

VHC49600 

497* 


IF ( GAMMA Y ,U. 0,Q) 6AMMAY 

= GAMMAC 

VHC49700 

498» 


IF (GAMMA2 ,L£. 0.0) GAMMaZ 

= GAMMAC 

VHC49800 

499* 


IF (ABS(GaMmAX»GAMMAY«-0,25) 

,LT, l,0E-6) GO TO 64 

VHC49900 

tjUO» 


print 20U 


VhCBOOOO 

501* 


GO TO 64 


VHC50100 

bU2^ 

63 

QC = QC1(gV)*RFmCT 


VHC50200 

bU3^ 


QT = GTI(JV) 


VHC50300 

bU44t 


loM = i 


VHC50400 

b05* 


*IF (GAMMAX ,L£. 0,0) gammax 

= GAMMAI 

VHC50500 

b06* 


IF (6AMMAY .Lt. 0,0) GAMMaY 

= GaMMAI 

VhC50600 

bU7» 


IF (GAMMAZ .Lt, 0,0) GAMMaZ 

= GaMMAI 

VHC50700 

bU6>K 


IF (ABS(GAMmAX*GAMMAY»GAMMAZ-. 262144) .GB. l.OE-6) PRINT 2011 

VHC50800 

bU9* 


HEAT = HEATN(gV) 


VHC50900 

biO* 


normal = 1 


VHC51000 

bll* 


IbKiP(6) = 2 


VHC51100 

bl2« 

64 

CONTINUE 


VHC51200 

bi3* 


A = AA(JV) 


VHC51300 

bl4* 


B = BB(JV) 


VhC5l400 

bl5« 


C = CC(JV) 


VHC51500 

bl6« 


N = 3»JV-2 


VHC51600 

bl7* 


M = N+2 


VHC51700 



DO o5 I=l»3 


VHC51800 

bi9» 


J = ljM+I-1 


VHC51900 

bao« 

65 

LimTL(I) - LNCH(J) 


VHC52000 

521* 


0 = 3 


VHC52100 

b'dZ* 


DO 66 I=N,M 


VHC52200 

b23# 


J = J-fl 


VHC52300 

b24<tc 

66 

LNTe(J) = TYPES(I) 


VHC52400 

525* 


LiNTL(7) = LnCH(IO) 


VHC52500 

b26« 


LnTl(8) = LnCH(II) 


VHC52600 

S27* 


If (HM ,GT, 0,0) GO TO 70 


VHC52700 

b26« 


HM = Z(NZS) 


VHC52800 

029* 

70 

CONTINUE 


VHC52900 

bbO* 


print 2005» (LNTL(J) »0=1»8) 


VHC53000 

bbl« 


CALL CONST ( 0 » nO , YES » IPOL » I TP , IFEET » KNOTS » ISW ( 8 ) , TpROP ) 

VHC53100 

532* 

C 

CONVERT FEET TO METERS IF* IFEET = F 

VHC53200 



CM to 



IF (ISW(l) ,LT, 2 ,aN0.ISW(2) ,UT. 2) GO TO 73 
ISW(4) = 0 
ISW(5) = 0 
ISW(6) = 0 

IF (2LIM .LE. 0.0) ZLIM = HM 
JSWS = ISMU) 

IF (DURaT .LE. 0.0)DUKAT = 1.0 
IF (RAINRT .L£. 0.0) RAINRT = 0.3 
IF (LAMBDA ,U£. 0,0) LAMBDA = 5.2E-4»RAINRT**0.567 
IF (ISW(ll) .£Q. 1) ISKIP(4) = 1 
73 CONTINUE 

IF (IF£ET ,N£. ITP(D) 60 TO 76 
ZLIM = ZLIM*. 3048 
DO 75 K=1»NZS 
7b Z(K) = Z(K)».3048 
HM = HM*,3048 
ZRK = ZRK*.3048 
ZSP s ZSP*.3048 

76 CONTINUE 

CONVERT Knots to meters/sec if knots = k 

IF (KNOTS .NE. ITP(2)) 60 TO 78 
DO 77 Krl»NZS 

77 WS(K) = WS(K)^. 514791 
76 continue 

80 DO 61 KslfNZS 

IF (Z(K)-l.O ,LT, HM.AND.HM ,lT, Z(K)+1.0) 60 TO 82 

81 CONTINUE 
GO TO 400 

82 KS = K 

convert temperature from degrees CELSIUS TO ABSOLUTE 
DO 90 K=1»NZS 
90 T(K) = T(K)+273.16 

CALCULATE VIRTUAL POTENTIAL TEMPERATURE 
DO lOO KslrNZS 
XT = 1.0*-373.16/T(K) 

XT = 1013. 25*EXP(XT*(13.3185+XT*(-1,976+XT*(-. 6445-. 1299*XT) )) ) 

XT s RH(K)*.01*XT 

XT s 0.622^XT/(P(K)-XT) 



572* 

573* 

574* 

b75» 

576* 

b77* 

b78* 

b79* 

580* 

b 81 « 

b82* 

b83* 

bb4+ 

bbS* 

b86« 

b87* 

588« 

589* 

b90* 

b^l* 

592* 

b93* 

b94* 

b95* 

b96* 

b97* 

b98* 

599* 

bOO* 

601* 

602* 

603* 

b04* 

605* 

o06* 

607* 

608* 


XT = T(K)*(l.0->-l,6l*XT)/(l,0+XT) 

100 TV(K) = CPH1(XT,P(K) ) 

C CALCULATE PlUME RJSE 

IF (NORMAL ,EQ. 0) 00 TO 120 
call PLUME! 

IF (IFLG .OT. 0) 60 TO 410 

IF (JV ,NE# 3.AND,JV ,NE. 5) GO TO 130 

ZMSV = ZM 

oammax = gammac 
gammay = gammac 

GAMmAZ : GAMMAC 

120 continue 

CALl PLUME2 

IF (IFLG *6T. 0) GO TO 410 
IF (JV .NE. 3.AN0»JV .NE. 5) GO TO 130 
IF (NORMAL ,EU. 0) GO TO 130 
GAMmAX s 0,5*(GAMMAI+GAMMaC) 

GAMmAY r GAMMaX 
GAMmAZ = gammax 
ZM = ,5*(ZM+ZMSV) 

DO 121 I=2»NZS 

IF (ZM ,LT. Z(in GO TO 122 

121 CONTINUE 

122 call LEAST(Z»TV»DPO^»I»0»0.0»0.0) 

IF (DPDZ .LT. 3.322E-4) DPOZ s 3.322E-4 
130 CONTINUE 

IF (ISW(7) ,,NE. O) CALL DELTXY 
C CALCULATE TuRBULENCL PARAMETERS 

call TURB 

C CALCULATE SOURCE DISTRIBUTION FOR MODEL A 
CALL DIST4(iSW(8) ) 

c Calculate source dimensions for model 4 

IFLG = 1 
call D1M34 
dbOT = 1 
NNZ s NZS-1 
JTOp = KS-1 
J = 4 


VHC57100 

VHC57200 

VHC57300 

VHC57400 

VHC57500 

VHC57600 

VHC57700 

VHC57800 

VHC57900 

VHC58000 

VHC58100 

VHC56200 

VHC58300 

VHC58400 

VHC58500 

VHC58600 

VHC58700 

VHC56800 

VhC56900 

VHC59000 

VHC59100 

VHC59200 

VhC59300 

VHC59400 

VHC59500 

VHC59600 

VHC59700 

VHC59800 

VhC59900 

VHC60000 

VHC60100 

VHC60200 

VHC60300 

VHC60400 

VHC60500 

VHC60600 

VHC60700 

VHC60800 



609« 


IF USW(l) ,EO. 2) wl = 54 


VhC60900 

610* 


DO 131 I=JBOT»JTOP 


VHC61000 

oil* 

131 

12MOO(I) = u 


VHC61100 

&12* 


IF (vlTOP .GE, NNZ) go to 134 


VHC61200 

613* 


J s JTOP+l 


VHC61300 

ol4* 


N1 £ 0 


VHC61400 

615* 


IF (ISW(IO) ,£Q, O.AND.ZSp ,LE. Z(JTOP+l)) GO 

TO 132 

VHC61500 

6l6* 


IZMODN) = 94 


VHC61600 

ol7* 


J = J+1 


VHC61700 

616* 


IF .GT, NNZ) GO TO 134 


VHC61800 

619* 


N1 : 4 


VHC61900 

620* 

132 

DO 133 I=J»nNZ 


VHC62000 

o2l* 

133 

IZMOO(I) = N1 


VHC62100 

622* 

134 

CONTINUE 


VHC62200 

623* 


XX s l,0E3*22»4*10l3,2*T(l>/(273,16*Pa)) 


VHC62300 

624* 


li = 4 


VHC62400 

625* 

C 

OUTPUT namelist NAM2 FOR HCL» CO» C02» AL203 

model 4 

VHC62500 

626* 


ISKXPC9) = 0 


VHC62600 

627* 


IF <ISW(1) ,EQ. 2«AND.ISW(9) ,EQ. 0) iSKIP(9) 

= 0 

VHC62700 

628* 


IF USW(l) .EG, 2 ,aNiO.ISW(9) ,EQ. 1) ISKIP(9) 

= 1 

VHC62800 

629* 


00 200 I=l»4 


VHC62900 

630* 


DO 151 K:1»NNZ 


VHC63000 

631* 

151 

QF(K»I) = 0,0 


VHC63100 

632* 


ISKIP(5) = I 


VhC63200 

633* 


NTI r 61 


VHC63300 

634* 


IF (I *EQ« 1) NTI = 62 


VhC63400 

635* 


IF (I *EQ* 3) NU = 69 


VHC63500 

636* 


IF USW(l) ,N£, 2) GO TO 135 


VHC63600 

637* 


NTI 5 0 


VHC63700 

636* 


NCI = 0 


VHC63800 

639* 

135 

CONTINUE 


VHC63900 

640* 


DO 136 JslflO 


VHC64000 

p41* 


IF (I .GT, 1.0R,ISW(9) ,EQ, 0) 60 TO 136 


VHC64100 

04a* 


01(0) = DDIP(U) 


VhC64200 

643* 


GO TO 137 


VHC64300 

644* 

136 

DI(U) = DD1(J»I) 


VHC64400 

645* 

137 

TKu) = TTKJiI) 


VHC64500 

646* 


CI(J) = CCl(Jfl) 


VHC64600 



o*+8* 

o49* 

bbQitc 

obl« 

Dt>2* 

bb3>t‘ 

ob4+ 

otb* 

Ob&4< 

ot>7* 
pbB^c 
ob9* 
obO* 
bbl* 
bb£» 
bb3t 
ob4* 
bbb* 
obb* 
ub7* 
ob8» 
ob9» 
670* 
671* 
b72* 
673* 
o74* 
b i^5* 
p76* 
o77* 
o7b* 
679* 
obO* 
bbl* 
ob2* 
663* 
664* 


II- (ISWd) ,Ne, 2) 60 TO 138 
C1(J) = 0.0 
TX(J) = 0.0 
138 CONTINUE 

C calculate CONvEKSTION FACTOR TO PPM FOR HCL» CO, C02 AND TO 

C MiLulGRAMi PER CUblC METER FOR AL203 mND ADJ FOR PERCENT OF MAT. 

IF aSw(l) ,Eu. 2) 60 TO 142 
IF (I .to. 4) 00 TO 3.40 
Q^ = (XX/rtTMOLd) )*FRQ(I) 

60 TO 150 

140 Q« = l,0£3*FRoa) 

60 TO 150 

142 IF (I ,gT, 1) Go TO Ibl 

IF (ISW(9) ,EO. 0) 60 TO 140 

Q^ = 1.0/(RAlNRT*25.4*ftTMOL(I)*oURAT) 

IF (ISyv(ll) .EQ. 1) Qk = QK*DURaT 
C CONVERT Q TO PROPER UNITS AND PERCENTAGE OF POLLUTANT 
IbO DO 160 K=1»NN2 
XFT = QK*0(^) 

160 QF(K»I) = XfT 
Ibl CONTINUE 

IF aSW(l) .EO. 0) 00 TO 200 
IF iISW(3) ,Eu. O.aND.I .eg. 1) 60 TO 200 
IF (IS\^(4) . EO. 0 .AND. I .EQ. 2) GO TO 200 
IF (ISVi(5) ,EO. O.aND.I .£Q, 4) 60 TO 200 
IF (ISa( 6) ,Ey. O.aND.I .EG. 3) 60 TO 200 
PnInT 200b,iMAMCHS, (LNTL(J) ,J=1»8) 
print 2007 
K = 1 

IF (I .EQ. 4) K = 3 
IF USa( 2) ,6T. 0) 60 TO 170 
IF (IHM .NE. i3NK) 60 TO 170 
IF (I .EO. IPnPS) NPS = 1 
170 CO.NTINUE 
NVHCL = UV 
NMOdL = 4 

IF (ISa(1) .Eu. 2) NMOOL = 54 
NPLinT = I 


VHC64700 

VHC64800 

VHC64900 

VHC65000 

VhC65100 

VHC65200 

VHC65300 

VHC65400 

VHC65500 

VHC65600 

VFJC65700 

VHC65600 

VHC65900 

VHC66000 

VHC66100 

VHC66200 

VHC66300 

VHC66400 

VHC66500 

VHC66600 

VHC66700 

VHC66800 

VHC66900 

VHC67000 

VhC67100 

VhC67200 

VHC67300 

VHC67400 

VHC67500 

VhC67600 

VhC67700 

VHC67800 

VHC67900 

VHC68000 

VHC68100 

VHC68200 

VHC66300 

VhC68400 



ott5* 



WKITE ( 6 » 2002 ) (TYp£S( J) » J=N»|vl) , IPoLU ) »NM0D1- 


VHC68500 

otJ6* 



WKITE (6»20l0) METUNTr (METDAT(J) »J=1»3) »NSND» 

iount 

VHC68600 

i)H7* 



DATe(6) = BlKS 


VHC68700 

otJ8* 



print 2001r (OATE(U) r J=lf 6) , (TYpES( J) » J=N,M) 


VHC68800 

btt9* 



IbTKT = lASV 


VhC68900 

690* 



IF lIOUNT .NE. 7) wHITE(IOONT»IaSV»2001) (DATE( J) »sJ=1,6) 

, (TYPES(0)VHC69000 

oVl* 


1 r 


VHC69100 

692* 



IF (lOUNT .EQ. 7) PUNCH 2001» (DATE (U) » 0=1 »6) 

, (TYPES(O) » 

0=N,M) VHC69200 

693* 


180 

CALL OUTPT(KSfIr4,lSTRTrISW(10) »ZSP) 


VHC69300 

b94* 


200 

continue 


VHC69400 

o95* 



IF (ISftd) .EU. 0) 60 TO 205 


VHC69500 

696* 



print 2005» NAMCASf (LNTL(J) f 0=1,8) 


VHC69600 

697* 



call const ( 4 , no , YES r IPOL , I TP , I F eET , KNOTS , 1 SW ( 8 ) , TPROP ) 

VHC69700 

q»98* 


205 

CONTINUE 


VHC69800 

w99* 

C 


OUTPUT NAMELIST NAM2 FOR HCL» CO, C02, AL203 

model 3 

VHC69900 

7U0* 

C 


CALCULATE SOURCE UI5TRIBUTI0N FOR MODEL 3 


VHC70000 

701* 



CALL DIST3(lSrt{8)) 


VHC70100 

/02* 

C 


CALCULATE SOURCE DIMENSIONS FOR MODEL 3 


VFIC70200 

703* 



I FLO = 0 


VHC70300 

704* 



CALl D1M34 


VHC70400 

705* 



2(2) = HM 


VhC70500 

706* 



Si6AP(2) = SIOAP(KS) 


VHC70600 

707* 



SIGeP(2) = SIOEP(KS) 


VhC70700 

708* 



WD(2)’ = WU(KS) 


VHC70800 

709* 



UoAR(2) = UtJAR(KS) 


VHC70900 

710* 



UMOD(I) = 3 


VHC71000 

711* 



IF (ISW(2) ,E(il. 2) IZMOD(l) = 53 


VHC71100 

712* 



DX(1) = DX(KS-l) 


VHC71200 

713* 



DY(1) = DY(KS-l) 


VHC71300 

714* 



IF (SlGZO(l) .LE. 0.0) 60 TO 42o 


VF»C71400 

715* 



NnZ = 1 


VHC71500 

716* 



N2S = 2 


VHC71600 

717* 



KS = 2 


VHC71700 

718* 



11 = 3 


VHC71800 

719* 



ISKIP(9) = 0 


VHC71900 

720* 



IF (ISW(2) ,EQ. 2,AND.1SW{9) .EQ. 0) ISMP(9) 

= 0 

VHC72000 

721* 



IF (ISW{2) .EO. 2.AND.ISW(9) ,EQ, 1) ISKIP(9) 

= 1 

VHC72100 

722* 



DO 260 1=1,4 


VHC72200 


7i!3* 

/ii4# 

725* 

726* 

727 ^ 

728 * 

?29* 

730* 

731* 

732* 

733* 

734* 

735* 

736* 

737* 

738* 

739* 

740* 

741* 

742* 

743* 

744* 

745* 

/46* 

747* 

748* 

749* 

730* 

731* 

732* 

733* 

734* 

735* 

736* 

737* 

738* 

739* 

760* 


QF(1»I) = 0,0 
I5KiP(5) = 1 
NT! = 61 

IF (I ,EQ, 1) NTI = 62 

IF (I .EQ. 3) NTI = 69 

IF (ISW{2) ,NE. 2) 60 TO 20? 

NTI = 0 
NCI = 0 

207 CONTINUE 

DO 210 J=1*10 

IF (I .GT, 1,0R,ISW(9) ,EQ, 0) GO TO 208 
0I(J) = OQIP(J) 

GO TO 209 

208 DX(o) = DQI(J»I) 

209 TKJ) = TTI(Jfl) 

Ci(0) = CCI(J»I) 

IF (ISW(2) ,NE. 2) 60 TO 210 
Ti(J) = 0,0 
CI(u) 3 0,0 

210 CONTINUE 

C CALCULATE CONVERSION FACTOR TO PPM FOR hCL» CO» C02 AND TO 

C milligrams PER CUBIC METER FOR AL203 AND ADJ FOR PERCENT OF MAT, 

IF aSto(2) ,EO, 2) 60 TO 220 
IF (I .EQ. 4) GO TO 220 
QF(1»I) = Oa)*(XX/WTMOL(I) )*FRQ(1) 

GO TO 230 

220 IF (ISW(2) ,EO, 2, AND. I .GT. 1) GO TO 231 
QFUfI) = Qa)*1.0fc3*FRQa) 

IF (ISW(2) ,NL. 2) GO TO 230 
IF USW(9) ,EO. 0) GO TO 230 
QF(1»I) = Q(1)/(RAINRT*25,4*WTMoL(I)*DURAT) 

IF (ISW(ll) .EQ. 1) QF(1»I) = QF(1»I)*DURAT 

230 CONTINUE 

231 continue 


IF 

(ISW(2) 

.EQ. 

0) 

GO 

TO 

260 





IF 

(ISW(3) 

.EQ. 

0. 

and, 

,I 

.EQ. 

1) 

GO 

TO 

260 

IF 

(ISV»(4) 

.EQ. 

0. 

AND, 

.1 

. EQ . 

2) 

GO 

TO 

260 

IF 

(IS«(5) 

.EQ. 

0. 

AND, 

.1 

• EQ. 

4) 

GO 

TO 

260 


VHC72300 

VHC72400 

VHC72500 

VHC72600 

VHC72700 

VHC72800 

VHC72900 

VHC73000 

VHC73100 

VHC73200 

VHC73300 

VHC73400 

VHC73500 

VHC73600 

VHC73700 

VHC73800 

VHC73900 

VHC74000 

VHC74100 

VHC74200 

VHC74300 

VHC74400 

VHC74500 

VHC74600 

VHC74700 

VHC74800 

VHC74900 

VHC75000 

VHC75100 

VHC75200 

VHC75300 

VHC75400 

VHC75500 

VHC75600 

VHC75700 

VHC75800 

VHC75900 

VHC76000 



7t>l* 


IF (ISW{6) O.aND.I .EQ, 3) 60 TO 260 

VHC76100 



print 2005,nAMCAS» (LNTL(J) » J=1»8) 

VBC76200 

763* 


print 2007 

VHC76300 

764* 


K = 1 

VBC76400 

765* 


IF (I *EQ. 4) K = 3 

VBC76500 

766* 


IF {IBM .NE, IBNK) 60 TO 240 

VHC76600 

767* 


IF a .EQ. IPNPS) NFS = 1 

VHC76700 

768* 

240 

continue 

VHC76800 

769* 


NVHCL = UV 

VBC76900 

770* 


NMOuL = 3 

VHC77000 

771* 


IF (ISW(2) ,E0, 2) NMODL = 53 

VHC77100 

772* 


JSWS = ISW<2) 

VHC77200 

773* 


nplnt = I 

VBC77300 

774* 


write (6»2002) (TYPLS(J)»J=N»M)»IPOL(I)»NMODL 

VHC77400 

775* 


Write (6»2010) METUNT* (METDAT(J)»J=1»3)»NSND»10UNT 

VBC77500 

776* 


0ATt(6) = BLKS 

VHC77600 

in* 


print 2001» (DATE(J)»U=1»6)»(TYPES(J)»J=N,M) 

VHC77700 

gS 778* 


ISTRT = lASv 

VHC77800 

779* 


IF (lOUNT ,nE. 7) write ( I0UNT» IASV»2001) (DATE(J) r J»l»6) r (TYPES(JVHC77900 

780* 

1 ) f wIzNr^'!) 

VHC78000 

781* 


IF (lOUNT .£Q, 7) PUNCH 200l» (DATE(J) »U=lr6) » (TYPES( J) i J=N»M) 

VBC78100 

782* 

250 

call OUTPT ( KS r 1 , 3 , ISTRT r ISW (10 ) , ZSP ) 

VHC78200 

783* 

260 

continue 

VHC78300 

784* 


IF (ISW(2) ,E0, 0) 60 TO 500 

VBC78400 

785* 


print 2005» NAMCASr (LNTL(J) »J=1»8) 

VHC78500 

786* 


CmLl const ( 3 » NO » yes » IPOL » I TP » IFeET . KNOTS r I SW ( 8 ) » TpROP ) 

VHC78600 

787* 


60 TO 500 

VHC78700 

788* 

o 

o 

print 2003 

VHC78800 

789* 


GO TO 500 

VHC78900 

7V0* 

410 

II = 2 

VHC79000 

791* 


IF (IFEET ,NE. ITP(D) 60 TO 411 

VHC79100 

792* 


li = 1 

VHC79200 

793* 


ZM = ZM/,3048 

VHC79300 

794* 

411 

print 2004 » ZM,UP(II) 

VHC79400 

795* 


60 TO 500 

VHC79500 

796* 

420 

print 2008 

VHC79600 

797* 

500 

IF (IBM .NE, I3NK) 60 TO 5 

VBC79700 

798* 

C ADD iZERO ON UNIT 12 TO INDICATE LAST RECORD 

VHC79800 



yyg* 

dUO« 

oUl« 

oU24c 

OU34t 

oU4# 

dU54t 

d06« 

o07* 

<J08* 

b09* 

dlO« 

ol2« 

813* 

ol4* 

dlb* 

816 * 

817# 

816* 

819* 

oidO* 

8<il* 

0^2* 

o23* 

824* 

825 * 

826* 

827* 

828 * 

829* 

830 * 

831 * 

832* 

833* 

834 * 

835 * 

836* 



IF (lOUNT ,E0, 7) STOP 

VHC79900 


WRITE (12*2012) (I2ER0*J=1*9) 

VHC80000 


ENOFILE 12 

VHC80100 


ENDFILE 12 

VHC80200 


rewind 12 

VHC80300 


write (6*2013) 

VHC80400 

510 

continue 

VHC80500 


Read (12*ioo2*end=520) namcas 

VHC80600 


write (6*2014) namcas 

VHC80700 


GO TO 510 

VHC80800 

520 

‘CONTINUE 

VHC80900 


REWIND 12 

VHC61000 


STOP 

VHC81100 

1000 

format ( 11 »2A3*2A1*5a6*2F6,0*F7,0*F8. 0*1411) 

VHC81200 

1001 

format (6F10.0*19X*A1) 

VHC81300 

1002 

format (13A6*A2) 

VHC61400 

1003 

format (I2*2X*312*2X*I2*2X*I2) 

VHC81500 

1006 

format (3F4,2) 

VHC81600 

2001 

Format (6H $NAM2/11H TESTN0=60H*9A6*7h *) 

VHC81700 

2002 

format ( 1H * 3A6 * lOX * A6 * 1 ox * 6HM0DEL= * 12 ) 

VHC81800 

2003 

format (84H0 **ERR0R** hm must be equal to one of 

THE layer BOUNDAVHC81900 

IRIES z and in The same units./) 

VHC82000 


2004 format (70h 0 **ERR0R** NOT ENOUGn LAYERS» TOP OF LAST LAYER MUST VHC82100 

IBfc oREATER THAN ,lpE12,5»lX»A6»l9Hr INPUT MORE LAYERS/) VHC82200 

2005 format (1H1»21X,8H*-*-*-* »12A6f8H *-*-*-*/29X»8H*-*-*-* ,3A6, 1X»5VHC82300 

1A8»8H *-*-♦-*/) VHC82400 

2006 format (58H ***eRR0K*** COLUMNS 1-3 ARE INCORRECTLY PUNCHED ON CARVHC82500 

ID 1} VHC82600 

2007 format (28X,75H*-* NAMELIST NAM2 FOR INPUT TO THE NASA/MSFC MULTILVHC82700 

lAYER model VERSION 5 *-*//) VHC82800 

2008 format (102m1*-* CLODQ RISE IS WELL ABOVE HM, MODEL 3 PARAMETERS AVHC82900 

IRc. not calculated* use model 4 FOR THIS CASE *-*) VHC83000 

2009 format (54H *WARNING* VEHICLE TYPE NOT SPECIFIED^ TITAN HIC USED) VHC83100 

2010 format (1H »7riMETUNT=»I2»5X»7HMETDAT=»I2»lH/»l2»lH/»I2*5X,17HH0UR VHC83200 

lOF soundings* 12 »5X*28hI0UiMT (NAMELIST OUTPUT UNIT) = »I2//) VHC8330Q 

2011 format (126H0 ***WARNING*** PRODUCT OF GAMMA *S IS NOT CORRECT* SEE VHC83400 

INOTt ACCOMPANYING DEFINITION OF GAMMA »S FOR ELLIPTICALLY SHAPED SOVHC83500 
2UKCES/) VHC83600 



o37* 

ZQIZ 

FORMAT 

(Il»3I2rZ2rl3rilf2l6) 

VHC83700 

838« 

20i3 

FORMAT 

(1H1»26H0UMP OF NAMELIST DIRECTORY) 

VHC63600 


2014 

format 

(IH »12A6) 

VHC83900 

840* 


END 


VHC84000 


CO 

cn 



SUBROUTINE cONSTf VERSION 6, REVISION 0 


subroutine CONST (JFl-6»N0»YES»IP0L»ITP»IFEETrKN0TS»ISW8»TPR0P) CSTOOlOO 

COMMON /PUUmE/ QC » A » B » C » HEAT » RHO » CP » PI » 6AMMAX , OAMMAY » GAMMaZ » T { 21 ) » CST00200 
1P(21) »Z(21) ,UBAR(21) »NZS»0(20) fQT»HM»SI6EP(21) »SI6AP(21) »G»TAUK» CST00300 
2N0RMAL»TV(21) rRH(21 ) »NAMCaS(12) ,NAMT(12) »SIGAR CST00400 

COMMON /REST/ 2M»DPUZ»K»Al»Bl»PHll»ZP»TZ»PZ»PHlf IFL6»KS CST00500 

common /SIG/ SIGXO(20) ,SIGYO(20) »SI6ZO(20) CST00600 
common /F/ 0ATE(6) »FR0(4) »WTM0L(3) CST00700 

common /OUT/ OF(20»4) ,W0(21) »ISkIPU 0) ,NDI»NCI»NTi»ZRK»JBOT»JTOP» CST00800 
IUM0D(21) »CI(10) »DI(10) »TI(10 )»nPS CST00900 

C0Mm0N/DISPl/DXX»DX(21) »DYY»DY(21)»ILXY»TIMC(21) CSTOIOOO 

common /PRECIP/ RAINRT»LAMBDA»TiM1,ZLIM»DURAT, JSWS»EXTR(70) »NSPECLCST01100 
integer EXTR CST01200 

real LAMBUA CST01300 

dimension IFQ(4) CST01400 

data IFQ/24h feet METERSKNOTS MeT/S / CST01500 

data IBLK»IPH/1H »3H PH/ CST01600 

dimension IP0l(4) CST01700 

dimension ITP(2) CST01800 

Integer yes cstoi90o 

IF (JFl-6 .GT, 0) GO TO 20 CST02000 

print 2000» QC»0T»A»B»HEAT»CP CST02100 

2000 format (IH0»41X, 47H*-* INITIALIZED DATA USED FOR ABOVE VEHICLCST02200 

IE ♦-.♦//20X»69HQC - RATE OF OUTPUT OF EXHAUST MATERIAL FROM VEHICLECST02300 
2 IN grams/sec IS »lPE15,8/ CST02400 

320X,58HQT ^ TOTAL AMOUNT OF VEHICLE EXHAUST MATERIAL IN GRAMS IS rCST02500 
4E15.8/ CST02600 

520X,64HA ANQ B - VEHICLE RISE PARAMETERS IN THE EQUATION TRsA*Z**BCST02700 
6 are »0PF8,6»5H AND »F8,6/ CST02800 

720X,45HHEAT - TOTAL HEAT OUTPUT IN CALORIES/GRAM IS »F10.4/ CST02900 

820X,29HCP - SPECIFIC HEAT OF AlR IS »F5,3) CST03000 

print 2008 » GAMMAXfGAMMAY, GAMMAZ CST03100 

2008 format (20X,36HGAMMAX - X ENTRAINMENT PARAMETER IS »F7.4/ CST03200 

120X»36H6AMMaY - Y ENTRAINMENT PARAMETER IS »F7.4/ CST03300 

220X,36HGAMMaZ - Z ENTRAINMENT PARAMETER IS »F7.4) CST03400 

print 2001» IP0L»FRQ»^TM0L CST03500 

2001 format (20X,23HPOLU1ANT MATERIALS ARE f4(A6»lH»)/ CST03600 


39* 

40* 

41* 

42* 

43* 

44* 

45* 

46* 

47* 

48* 

49* 

bo* 

bl* 

b2* 

b3* 

b4* 

b5* 

b6* 

b7* 

bS* 

b9* 

bO* 

bl* 

b2* 

b3* 

b4* 

b5* 

b6* 

b7* 

b8* 

b9* 

70* 

71* 

72* 

73* 

74* 

75* 

76* 


120X,50HFRACTIONaL DISTRIBUTION OF THE ABOVE MaTeRIAUS IS ,4(F5.3» 
2lHr )/ 

320X,43HMOLEcULAR W£I6HT Of the above materials iS »3(f7.3»1H») ) 

J1 s NO 

(NORMAL ,EQ. 1) U1 = Y£S 
= NO 

(IFEET .eg. iTP(D) J2 = YES 
= NO 

(KNOTS .EO. 1TP(2)) J3 s Y£S 
= IFQ(2) 

YES) N1 = IFQ(l) 


IF 

J2 

IP 

J3 

IF 

N1 

IF 

N2 

IF 


(J2 .EG* 
= IFQ(4) 
(J3, .EG. 


print 2002i 


YES) N2 = IFQ(3) 

(UATE(l) »1-1»5) » J1 f J2* J3f TPR0P»SISAR »RH0»HM 
2002 format (lH0,52Xr26H*-X PROGRAM INPUT DATA *-*//25Xt IIHDAT a CARD 
129X,8HTITLE • »5Ab/29Xr28HN0RMAL - IS LAUNCH NORMAL ? »A3/ 
229X,54HIF£ET - ARE LAYER BOUNDARY HEIGHTS Z» AND HM IN FEET? 

- IS THE WIND speed WS IN KNOTS? »a3/ 


- THE INITIAL TEMPERATURE OF THE PROPELLANT IN 
IS ,F6*l/ 

^ standard deviation of the azimuth wind angle 


IS fF9,3/ 
»F9.3) 


CST03700 

CST03800 
CST03900 

CST04000 
CST04100 
CST04200 
CST04300 
CST04400 
CST04500 
CST04600 
CST04700 
CST04800 
CST04900 
CST05000 
1/CST05100 
CST05200 
jA3/ CST05300 
CST05400 


329X*39HKN0TS 
829Xr77HTPR0P 

9S Fahrenheit 

429X,67HSIGAR 
5REES IS rF7,3/ 

629X*42HRH0 - AIR DENSITY IN GRAmS/CUBIC METER 
729X,39HHM - DEPTH OF SURFACE MIXING LAYER IS 
IF (ISW8 .EG. 0) PRINT 2009 

2009 format (29X,25HS0URCE SHAPE IS SPHERICAL) 

IF (ISW8 .EG. 1) PRINT 2010 

2010 format (29X,26HS0URCE SHAPE IS ELLIPTICAL) 
print 20U» NZS 

2011 format (25X.20HDATA CARO 1 THROUGH » I2/33X,67HLaYER BOUNDARY 
10 DIRECTION WIND SPEED TEMPERATURE PRESSURE) 

print 2003» N1.N2 

2003 format (39X,lMZ»lX»lH(»Ab,lH).4x»9HWD (DEG) f5X»2HWS»lX»lH( »A5rlH)CST06900 

lf2X,9HT (OEG OfbX.bHP (MB) »3X» 12HRH (PERCENT)) CST07000 

DO lO I=1»NZS CST07100 

10 print 2004. Z(I),WDCI)rUBAR(I)»T(I)»P(I)fRH(I) CST07200 

2004 format (34X,F9.3>9X»F9.4»4X»F9.4»5X»F9.3»3X»F9.3»5X»F7.3) CST07300 

GO TO 40 CST07400 


DEGREECST05500 
CST05600 
IN DEGCST05700 
CST05800 
CST05900 
CST06000 
CST06100 
CST06200 
CST06300 
CST06400 
CST06500 
WINCST06600 
CST06700 
CST06800 



n* 

79 * 

tiO* 

«!♦ 

tJ3+ 

ti4* 

as* 

as* 

b7* 

as* 

a9* 

90* 

91* 

92* 

93* 

94* 

95* 

96* 

97* 

98* 

99* 

iUO* 

101 * 

102 * 

103* 

104* 

105* 

106* 

107* 

106* 

109* 

110 * 

111 * 

112 * 

113* 

114* 


20 continue 

NnZ = NZS-1 
ZZL = 0.0 
N7 = JFL6 
IF (JSWS .GT. 


PKInT 2005f N7 


2005 format 

1/13x»39HH - 
213X.36HZM - 


1) N7 = N7+50 
05f N7»h»ZM»TAUK»DPDZ»JR0TfJT0P»ZZL 
(1H0,39X,36H*-* CALCULATED PARAMETER* 


»I2»4H 


calculated parameters for model 
ouu height in meters is rF9.3/ 
213X.36HZM - R£AL CLOUD HEIGHT IN METERS IS »F9.3/ 

313X,45HTAUK - TIME TO CLOUD STABILIZATION IN SEC IS »F9.3/ 
413X,73HDPUZ - VERTICAL GRADIENT OF AMBIENT POTENTIAL TEMP IN 
5ES K/METER is »F12.6/ 

613X»44HJB0T - BOTTOM LAYER FOR USE WITH MODEL 4 IS »I2/ 
713X,41HJT0P - TOP LAYER FOR USE WITH MODEL 4 IS »I2/ 

813X,58HZ - boundary HEIGHT AT ThE BOTTOM OF LAYeR 1 IN METERS 


.LE» 1) GO TO 25 


9Fo,3) 

IF (JSWS 
J1 = YES 
J2 = IBLK 

IF (ISKIP(9) ,£Q. 0) GO TO 24 
Ji = NO 
J2 = IPH 

24 print 20l2f RAINRT 
2012 format (13X,3 


AINRT#LAMBDA,TIMl»ZLIM»OURAT»Jlf J2 

4HRAINRT - Rain rate in in. /hour i; 


; format (13X,34HRAINRT - RAIN RATE IN IN. /HOUR IS ,E12.6/ 
113X,51HLAMBda - COEFFICIENT OF PRECIPITATION SCAVENGING IS» 
213X.42HTIM1 - TIME OF START OF PRECIP. IN SEC IS »F6.2/ 
313X,46HZLIM - MAXIMUM HEIGHT OF PRECIP. IN METERS IS »F7.2/ 
413X.39HDURAT - DURATION Op PRECIP. IN HOURS I5»F7.4/ 
513X.57HARE PRECIPITATION DEPOSITION OUTPUT UNITS TO BE MG/M 


CST07500 
CST07600 
CST07700 
CST07800 
CST07900 
CST08000 
*-*/CST08100 
CST08200 
CST08300 
CST08400 
DEGRECST08500 
CST06600 
CST06700 
CST08800 
IS fCST08900 
CST09000 
CST09100 
CST09200 
CST09300 
CST09400 
CST09500 
CST09600 
CST09700 
CST09800 
E12.6/ CST09900 
CSTIOOOO 
CSTlOlOO 


6A3) 

25 CONTINUE 

print 2006» 


M - duration of PRECIP. IN HOURS I5»F7.4/ CST10200 

PRECIPITATION DEPOSITION OUTPUT UNITS TO BE M6/M**2 -»2CST10300 

CST10400 
CST10500 

print 2006» ZRKfSlGAPU) »SIGEP(1) f IPOL CST10600 

2006 format (13X,83HSIGAP - STANDARD DEVIATION OF THE WIND AZIMUTH ANGLCST10700 
IE AT the measurement HEIGHT ZKK=»F6.2, IIH METERS IS »F8.3/ CST10800 

213X,65HSIGEP - STANDARD DEVIATION OF THE WIND ELEVATION ANGLE AT ZCST10900 
3RK IS »F8.3/19H LAYER PARAMETERS -/lOH LAYER Z»17X»21H- SOURCE SCSTllOOO 
4TRENGTH Q -,21X,59 hSIGAP SIGEP SIGXO SIGYO SIGZO dELX DECSTlllOO 
5LY CLD-RISE/12H NO. (LAY£R»56x»2(6H (DE6))»4(8H (METER) )» I'^H (BCST11200 



il5* bEv) TlME/6X»4HT0PJ»5X»Afar2(aX,Afa)»7X»A6»58X,5H(SEC>/) CSTU300 

U6* DO 50 K=1»NnZ CSTU400 

a17* 30 PKInT 2007» K * Z (K+1 ) » (QF I ) » 1=1 »4) »SIGAP (K+1 ) »SieEP(K+l ) »SIGXO(KcSTU500 

ue* 1) fSiGYO(K) »bIoZO(K) »DX(K) rDY(K) ,T1MC(K) CSTH600 

U9* 2007 format (1X» l3*F6.i» iP‘^El**.7r0P2F6,2»3F8,3rF8.2»F7,2»F9.2) CST11700 

120* 40 continue CSTllSOO 

iSil* RtToRN CST11900 

END CST12000 


CO 

CO 



1* 

z* 

3* 

SubKOUTiNE OUTPT» VERSION 6, REVISION 0 
SuBHOUTiNE OUTPT(N2» I t IK» ISTRTr lfe*10»2SP) 

OPTOOlOO 


common /Plume/ OC » a » B r C » heat » RHO » CP r P I » GAMMAX , gamma Y » GAMMaZ » T ( 21 ) » 

OPT00200 

5* 

IP (21) >2(21) ,UbAK(2l) »NZS»0(20) »0TrHM»SIGEP(21) rSlGAP(21) »6»TAUK» 

OPT00300 

6« 

2N0RmAL»TV(21) ,Rh(21) »NAMCaS( 12) ,NAMT(12) rSiGAR 

OPT00400 

7* 

common /SIG/ SIGXO(20) rSlGYO(20) ,SIGZO(20) »H 

OPT00500 


common /PRECIP/ RAlNRTfUAMbDA»TlMl»2LIM»DURATrJSWSfEXTR(70) >NSPECLOPT00600 

9* 

Integer extk 

OPT00700 

iO* 

real lambua 

OPT00800 

!!♦ 

common /OUT/ OFCZO,*^) » WD (21 ) » ISkIP ( 10 ) »NDI » NCI »NTI »2RK » JBOT»UTOP» 

OPT00900 

IZ* 

1UM0D(21) »CI(10) »0i(10) »TI(10) »nPS 

OPTOIOOO 

13* 

COMmON/DISPl/ DXX,DX(21) fOYY»DY(21) rILXY»TIMC(2D 

OPTOllOO 

14« 

common /CAScRD/ NVHCLfMETQAT(3) ,NMODLrNPLNTfNSNDf I0UNT»IASV 

OPT01200 

15« 

dimension QL(20) f I(ii(20) »JO(20) ^KO(20) 

OPT01300 

lb* 

dimension JE(15) 

OPT01400 

17* 

dimension Z2L(3) 

OPT01500 

18* 

data JE/90H 2 (5 UtJARK SiGAK SIGEK SIGXO SiGYO SI620THETAK 

OPT01600 

19* 

1 DI Cl DEUX DELY TI TeMPK/ 

OPT01700 

zo* 

N2M = NZ 

OPT01800 

21* 

IP (IK ,EQ. 4.AND.ZSP .GT, Z(NZ)) NZ = NZS 

OPT01900 

22* 

IF (IK ,EO. 4.AND.ISW10 «GT* 0) NZ = NZS 

OPT02000 

23* 

IF (NZ .GT. 16) NZ - 16 

0PT02100 

24* 

NNZ : NZ-1 

OPT02200 

25* 

Null = NDi/iO 

OPT02300 

26* 

NCIi = NCI/10 

OPT02400 

27* 

NTH = NTI/iO 

OPT02500 

ZB* 

NPTS = 0 

OPT02600 

29* 

tSUl = NSP£cL*14 

OPT02700 

30* 

ZZU(l) = 0.0 

OPT02800 

31* 

ZZL(2) = 0.0 

OPT02900 

32* 

Z4L(3) = 0.0 

OPT03000 

33* 

IF (ISWIO .eQ. 1) GO TO 5 

OPT03100 

34* 

NPTS = NPTS+1 

OPT03200 

35* 

ZZL(NPTS) = 0.0 

OPT03300 

36* 

b IF (ZSP .LE. 0.0) GO TO 6 

OPT03400 

37* 

NPTS = NPTS+1 

OPT03500 

36* 

ZZL(NPTS) = ZSP 

OPT03600 



d9« 

40* 

41« 

42* 

43* 

44* 

45* 

46 » 

47* 

48* 

49* 

b0« 

bl* 

bZ* 

bz* 

b4* 

b5* 

b6« 

b7* 

bB« 

b9* 

bO* 

fal* 

bZ* 

63* 

b4» 

65* 

b6« 

b7+ 

b6* 

b9* 

70* 

71* 

72* 

73* 

74* 

75* 

76* 


i999 

2006 


6 IP aSWlO .£Q, 0) $0 TO 7 
NPT& = NPTS+1 
Z2UNPTS) = H 

7 IP (NPTS .EO. 1) 00 TO 8 
IP IZZUNPTS) .OE. ZZL(NPTS-l)) GO TO 8 
ZT = ZZL(NPTS) 

ZZL(NPTS) = ZZL(NPTS-l) 

ZZL(NPTS-l) = ZT 

8 CONTINUE 
ZP = 0.0 
TIMaV = 600,0 

IP (1 .EO. 2) TIMAV = 560,0 
PPINT 1999f NAMCA8 

F0R|v,AT (1X»10HNAMCAS=66H»UA6»A2»1H» ) 

PKIiNT 2008 » NVHOL» (METLATiK) >K=1»5) »NSND»NMODLfNPLNT 
format ( 7H NVhCL= » 1 1 » 8H » METDATs , 3 1 1 2 » 1H » ) » 5HNSNQ= » 12 ♦ 7H » NmODLs » 1 2 
17HfNPLNT=»Il»lH») 

print 2000» IbKlP»NPSrNZfNDI»NCl»NTIfZRK»TAUKr (IZMOD(K) »K=1»NN2) 

print 2001» JEU) »2P» IZ(K) ,K=2»NZ) 

print 2002» UE12) » (G)FtK»I) fK=l,NNZ) 

print 2001» 0E(3) f (UBAR(K) »K=1»NZ) 

print 2001» JE(4) r (SIGAP(K) »K=1»NZ) 

print 2001f g£(5) » (SIGEP(K) »K=1»NZ) 

print 2001» uE( 6) f (SIGXO(K) »K=1»NNZ) 

print 2001» oE(7) » (SIGYO(K) »K=1»NNZ) 

print 2001» jE(8) » (SIGZO(K) »K=1»NNZ) 

print 200i» JE(9) * (WD(K) »Ksl,NZ) 

PRIimT 200b» TIMAV 

print 200X» OEUO) . (DKK) rK=lrNDII) 

IP (NCII .GT. O) print 200i» UE(ll) » (Cl (K) »K=X»NCII) 

IP (NTH .GT. 0) PRINT 200X» JE(X4) r (Tl (K) »K=X»NTH) 

print 200X» JE(X2) » IDX(K) »K=X»NnZ) 

print 200X» J£(X3) » (DV (K) »K=1»NnZ) 

print 200X» JEU5) . (TV(K) »K=lfN2) 

print 201X» NPTSf (ZZL(K) »K=1»NPTS) 

20XX format (XX»bHNPTS=»i2»bH»ZZL=»3(F8,3»XH» ) ) 
print 2005f H 

IP (JSWS .N£, 0) PRINT 20X0r LAmBDAHIMX rZLlM 


OPT03700 

OPT03800 

OPT03900 

OPT04000 

OPT04X00 

OPt04200 

OPT04300 

OPT04400 

OPT04500 

OPT04600 

OPT04700 

OPT04800 

OPT04900 

OPT05000 

0PT05X00 

»OPT05200 

OPT05300 

OPT05400 

OPT05500 

OPT05600 

OPT05700 

OPT05800 

OPT05900 

OPT06000 

OPT06100 

OPT06200 

OPT06300 

OPT06400 

OPT06500 

OPT06600 

OPT06700 

OPT06800 

OPT06900 

OPT07000 

OPT07X00 

OPT07200 

OPT07300 

OPT07400 


77* 

7S* 

79* 

til* 

az* 

bi* 

bn* 

bt* 

b7* 

ba* 

b9* 

90* 

91* 

92* 

93* 

94+ 

95# 

96* 

97* 

98* 

99* 

iUO* 

iUl* 

i02* 

i03* 

1U4* 

AU5* 

1U6* 

iU7# 

J.OB* 

109* 

ilOt 

ill* 

112 * 

113* 

114* 


2010 format (lXf7Ht5UMDA=»fc:i2.6,6HfTlMl=fF9.3»6H»ZHM=»F8,3»lH») 
IF ILSWI .GT. 0) PRINT 2012r (ExTR (K) rK=l rLSWl ) 

2012 format (13A6»A2) 
print 2003 

2000 format (7H lSKIP=f lO(il,lHf ) »4 HnPS=»I 2,5H»NZS=»I2»5H»ND1=»I2 
H=»i2»5H»NTi=,I2»5H»2RK=fF5,lflH»/6H TAUK=»F8.3,7 h» IZMOO= i 15 

2f)) 

(lX»A6flH=»7lF9.3flHf )/(lXi7(F9,3»lH» ) ) ) 
(1 X»a6»1H=»1P9(E14,7»1H»)/1X»5(E14.7»1H»)/(1X»5(E14.7 


2001 format 

2002 format 
1 ) 

2003 VORmaT 

2004 FwRmAT 


(5ri 4END) 

(1X»a6»1H=»4(FU.8,1HE»3aI»1H»)/1X»4(F11.8,1HE»3A1»1H 


llX»4(FU#8rlHtr3Ai»lH» ) ) 

200b format (3h H=»F9,3,1H») 

2006 format (7ri timav=»fo.i»ih» ) 

IF (IOONT ,NE. 7) GO TO 30 
PUNCH 1999 » NAMCAS 

PUNCH 2006f NVHCLf (METDAT(K) »K=1»3 ) »NSND»NMOOL»NPuNT 
PUNCH 2000» ISKlP»NPS»NZrN0l»NCl»NTI»2RK»TAUKf aZMOD(K) »K=1» 
PUNCH 2001» UE(1) »ZF» (Z(K) ,K=2 hmZ) 

DO 20 KrlfNNZ 
QL(K) = QF(K»i) 

20 CALU CONV(QL(K) rlQ(K) , JQ(K) »KQ(K) ) 

PUNCH 2004» J£(2) r (QUK) »KQ(K) »IQ(K) »JQ(K) »K=1 »nNZ) 

PUNCH 200i» Ut(3) » (UBAR(K) ,K=lrNZ) 

PUNCH 2001» U£(4) » (SICAP(K) »K=1,NZ) 

PUNCH 2001» J£(b) »XbIGEP(K) »K=1,NZ) 

PUNCH 2001» JE(6) » (SIGXO(K) rK=l,NNZ) 

PUNCH 2001» JE(7) f (SIGYO(K) rK=l,NNZ) 

PUNCH 2001r J£ (8) » ( bjeZO (K ) »K=1 , NNZ) 

PUNCH 2001» JE(9) » (WD(K) rK=l»NZ) 

PUNCH 2006» TIMaV 

PUNCH 2001» JEUO) » (DI(K) »K=1»NDII) 

IF (NCII .GT, 0) PUNCH 2001f JE ( 11 ) » (Cl (K ) »K=1 »NCI I ) 

IF (NTII .GT, 0) punch 2001» JE(14) » (TI (K) »K=l»NTiI) 

PUNCH 2001» JE(12) » (DX(K) »K=1»NnZ) 

PUNCH 2001» Jt(l3) » (DY(K) »K=1 »NnZ) 

PUNCH 2001» Ufc(l5) r CTV(K) ,K=l»NZ) 


OPT07500 
OPT07600 
OPT07700 
OPT07800 
r5H»NCOPT07900 
(I2»1HOPT08000 
OPT08100 
OPT08200 
»1H» ) )OPT08300 
OPT08400 
OPT08500 
»)/ OPT08600 

OPT08700 
OPT08800 
OPT08900 
OPT09000 
OPT09100 
OPT09200 
NNZ) OPT09300 
OPT09400 
OPT09500 
OPT09600 
OPT09700 
OPT09800 
OPT09900 
OPTIOOOO 
OPTlOlOO 
OPT10200 
OPT10300 
OPT10400 
OPT10500 
OPT10600 
OPT10700 
OPT10800 
OPT10900 
OPTllOOO 
OPTlllOO 
OPT11200 


U5« 

il6x< 

il7* 

lie* 

U9« 

120 * 

121 * 

122 * 

123* 

124* 

125* 

126* 

127* 

126* 

129* 

IdO* 

XU* 

132* 

1 ^ 3 * 

134* 

135* 

136* 

137* 

136* 

139* 

140* 

IHl* 

142* 

143* 

144* 

145* 

146* 

147* 

146* 

149* 

l&O* 

Ibl* 

132* 


PUNCH 20ll» NPTSt (22L(K) »K=1»NPTS) 

PUNCH 2005» H 

IF (JSWS .Ne, 0) PUNCH 20l0f LAMBDA»TIM1 » ZLIM 
PUNCH 2007r TAUK 

2007 format (lX»6HTAU0K=»F6,3»lHf ) 

IF (USWl ,6Ti 0) PUNCH 2012» (EXTR(K) »K=1»LSW1) 

PUNCH 2003 
SO TO 50 

30 write ClOUNT*lASVfl999) NAMCAS 

write (lOUNT»IASVf2006) NVHCLr (METDAT(K) »K=1 f3) »NSND»NM0DL»NPLNT 


OPTU300 

OPT11400 

0PT11500 

OPT11600 

OPT11700 

OPT11800 

0PT11900 

0PT12000 

OPT12100 

OPT12200 


WRITE (IOUNT'IASV*2000) ISKIP»NPS,NZ»NDI»NCI»NTI»ZRK»TAUK» (I2MOD(KOPT12300 
l)»K=lrNNZ) OPT12400 

WRITE (IOUNT»IASV»2001) UE(1) »Zf» (Z(K) ,K=2»NZ) QPT12500 


00 40 K=lfNNZ 


OPT12600 


Qu(K) = QF(K»I) 

40 CALL C0NV(QL(K) »IQ(K) »UQ(K) »KG(K) ) 


OPT12700 
OPT 12800 


WRITE (IOUNT*IASV»2004) JE(2) r (QL(K) »KQ(K) »IQ(K) »K=1»NNZ) 
WRITE (IOUNT»IASV»2001) JE(3) f (UBAR(K) ,K=1»NZ) 

WRITE (lOUNT*IAbV»2001) J£{4) » (SISAP(K) »K=1»NZ) 

WRITE (IOUNT*IA6V»2001) JE(5) » (SISEP(R) »K=1»NZ) 

WRITE (10UNT*IASV»2001) JE(6) r (SIGXO(K) »K=1»NNZ) 
write (lOUNT»IAbVf2001) JE(7) » (SIGYO(K) »K=1»NNZ) 
write (IOUNT*IASV>2001) JE(8) r (SIGZO(K) »K=1»NNZ) 
write (I0UNT'IASV»2001) UE(9) » (WD(K) »K=1»NZ) 

WRITE (IOUNT*IASV»2006) TIMAV 

write (IOUNT*IASV»2001) JE(10) » (DKK) »K=lrNDlI) 

IF (NCII .GT. 0) write ( lOUNT* I aSV , 2001 ) JE ( H ) , (Cl (K) ,K=l ,NCII ) 
IF (NTII .GT. 0) WRITE (IOUNT*IaSV,2001) JE(14) , (TI (K) ,K=1»NTII) 
write (IOUNT'IASV,2001) J£(12) , (DX(K) ,K=l,NNZ) 

WRITE (IOUNT»IASV,2001) JE(13) , (DY (K) ,K=1,NNZ) 

WRITE (IOUNT*IASV,2001) Jt ( 15) , (TV (K) ,K=1 f NZ) 

WRITE (IOUNT*IASV,2011) NPTS, (ZZL(K) ,K=1,NPTS) 

WRITE (IOUNT»IASV,2005) H 

IF (JSWS ,NE. 0) write ( lOUNT* I aSV ,2010 ) LAMBDA, TIMI ,ZLIM 
WRITE (IOUNT’IASV,2007) TaUK 

IF (LSWl .GT. 0) write ( IOUNT* IaSV,2012) (EXTR(K) ,K=1,LSW1) 
write (IOUNT»IASV,2003) 

IENd = lASV-1 


OPT12900 

OPT13000 

OPT13100 

OPT13200 

OPT13300 

OPT13400 

OPT13500 

OPT13600 

OPT13700 

OPT13800 

OPT13900 

OPT14000 

OPT14100 

OPT14200 

OPT14300 

OPT14400 

0PT14500 

OPT14600 

OPT14700 

OPT14800 

OPT14900 

OPT15000 



WKITE (I2f2009) NVHCLr (METDAT(K) »K=1»3) »NSND»NMODL»NPUNT»lSTRT» 

OPT15100 

Xb44c 

lIENg 

OPT15200 

lb5* 

2009 format (I3r3I2rl2rl3»Il»2l6) 

OPT15300 

ibb* 

50 CONTINUE. 

OPT15400 

Ab7* 

N2 = NZM 

OPT15500 

lbe« 

RETURN 

OPT15600 

ib9* 

END 

OPT15700 



SUBROUTiNt TURBf VERSION 6, REVISION 0 


!♦ 

2 * 

3* 

5* 

b* 

7 * 

8 * 

9 * 

J.0* 

11 * 

12 * 

13* 

14* 

15* 

16* 

17* 

18* 

19* 

20 * 

21 * 

22 * 

25 * 


subroutine TURB TRBOOlOO 

COMMON /PLUME/ QC » A » B r C » HEAT » RHO » CP » P I » 6AMMAX , SaMMAY » GAMMaZ » T < 21 ) » TRBO 0200 
IPUl) »Z(21) fUBAR(2l) »N2S»Q(20) »QTrHM»SIGEP(21) »SI6AP(21) »e»TAUK» TRB00300 
2N0RMALf TV (2X ) r RH (21 ) f NAMCAS ( 12) ,NAMT ( 12) »SIGAR TRB00400 

common /REST/ ZM.DPUZfK»AlfBl»PHll»ZP,T2»PZ»PHl»lFUG»KS TRB00500 

Phil = G*OPDZ/Ta) TRB00600 

TaUK = Pl/SuRT(PhIl) TRB00700 

IF (TAUK .GT. 600.0) TAUK z 600,0 TRB00800 

K = 0 TRB00900 

10 K = K+1 TRBOIOOO 

IF (K .GT. NZS) go to 40 TRBOllOO 

IF ,(Z(K) .GT. HM) gO TO 35 TRB01200 

SIGaP(K) = SIGAP(l) TRB01300 

SIGeP(K) = SIGAP(i) TRB01400 

Gu TO 10 TRB01500 

35 SIGaP(K) 5 1.0 TRB01600 

SIGeP(K) = 1.0 TRB01700 

GO TO 10 TRB01800 

40 CONTINUE TRB01900 

return TRB02000 

END " TRB02100 


1* 

a* 

3* 

Subroutine qeltxy» version 6, revision o 
subroutine qeltxy 

DXYOOlOO 

4* 

COMMON /PlUmE/ OC » a » B » C » HEAT » RHO » CP » PI » GAMMAX , GaMMA Y » GAMMaZ » T ( 21 ) 

,DXY00200 

5« 

IPUl) fZ(21) rU6AR(Zl) »NZS»G(20) »0T»HM»SIG£P(21) »SIGAP(21) »G»TAUK» 

OXY00300 

6* 

2N0RMAL»TV(21) fRH(21) »NAMCAS(12) rNAMT(12) rSIGAR 

DXY00400 

7* 

common /REST/ ZM»DPDZ»K»AlrBlfPHll»ZP»TZ»PZ»PHl»lFLG»KS 

OXY00500 

6* 

common /OUT/ OF(20,4) ,WD(2l) rlSKlPUO) ,NYS»NDI »NCl »NBK»NPT5»ZRK» 

OXY00600 

9* 

lJbOT»JTOP»lZMOD»CI(10) »DI (10) » ZZL(2) 

OXY00700 

10* 

COMmON/DISPL/ DXXfOX(21) rDYY»DY(21) »ILXY»TIMC(21) 

OXY00800 

ll* 

IP = 4 

DXY00900 

12* 

Xu = GAMMAZ 

OXYOIOOO 

13* 

IF (NORMAu ,EO. 1) GO TO 5 

DXYOllOO 

m* 

IP = 3 

DXY01200 

15* 

Xu = 1,0 

DXY01300 

lb* 

5 UF = 0,0 

OXY01400 

17* 

ZF = 0.0 

DXY01500 

18* 

A1 = RHO*CP*PI*GAMMAX*GAMMAY*XL/(3,0*QC*HEAT) 

DXY01600 

19* 

IF (NORMAL ,EO, 1) A1 = Al/A 

DXY01700 

20* 

B1 = G/T(l) 

DXY01800 

21* 

S = 1,0/SORT(6*DPDZ/T(1) ) 

DXY01900 

22* 

PPI = PI*5,55b5b5&£-3 

DXY02000 

23* 

tstr. = pi»s 

OXY02100 

2t** 

PPIi = 1.0/PPl 

DXY02200 

25* 

DaX = 0,0 

DXY02300 

2b* 

DYY = 0,0 

OXY02400 

27* 

I = 0 

DXY02500 

28* 

II 

o 

• 

o 

DXY02600 

29* 

10 I = i+l 

DXY02700 

30* 

IF (I .GE, NZS) 60 TO 30 

DXY02800 

31* 

call least (Z * tv .DP oZSr I+l, 0» 0,0, 0,0) 

DXY02900 

32* 

IF (DPDZS ,lT, 3.322E-4) DPUZS = 3,322E-4 

DXY03000 

33* 

BK = Al+DPDZS 

DXY03100 

3H* 

IF (NORMAL ,EO, 0) GO TO 12 

DXY03200 

3b* 

BR z BK/(Z(i+l)*+fc5+C/A) 

DXY03300 

3b* 

GO TO 15 

DXY03400 

37* 

12 CONTINUE 

DXY03500 

38* 

UFSz UF+(Z(I+1)-Z(I) )*.5*(UBAR(I+1)+UBAR(I) ) 

DXY03600 



i9* 


2FS= ZF+(2(I+1)-Z(I) ) 

DXY03700 



8^ = BK*UFS/ZFS 

DXY03800 


lb 

continue 

DXY03900 

*♦2* 


ZD = BK*Z(I+1)**IP 

DXY04000 

•+3* 


IF (ZD ,GT. 2,0) GO TO 20 

DXY04100 



THEIAK = (WDU+D+wUa) )*0,5 

DXY04200 

45* 


IF (ABS(WD(1+1)-WU(1)) .GT. 160,0) THtTAK = THETAK-160.0 

DXY04300 

46* 


Bb = 1,0-ZD 

DXY04400 

47* 


IF (Bb ,GT. 1,0) bb = 1.0 

DXY04500 

46* 


IF (BB ,LT."'1*0) BB — “1.0 

DXY04600 

49* 


S = 1.0/SORT(B1*DPDZ5) 

DXY04700 

bO* 


Tk = S»ARC05(BB)“TT 

DXY04800 

bl* 


TT = TK+TT 

DXY04900 

b2* 


IF (TT .Lb. TSTK) go 10 17 

DXY05000 

b3* 


Tf = TT-TK 

DXY05100 

54* 


GO TO 20 

DXY05200 

b5* 

17 

continue 

DXY05300 

b6« 


UP = UFS 

DXY05400 

57* 


ZF = ZFS 

DXY05500 

56* 


IF (NORMAL .EG. 0) GO TO 18 

DXY05600 

b9* 


RK = 0.5*(Ut>AR(I + l)+UuAR(I) )*TK 

DXY05700 

60* 


GO TO 19 

DXY05800 

61* 

16 

Rn = uf*tk/zf 

DXY05900 

62* 

19 

CONTINUE 

DXY06000 

63* 


Bb = TFiETMK*PPI 

DXY06100 

64* 


DT(l) = DY(I-1)-RK*C0S(BB) 

DXY06200 

6b* 


DX(i) = DX(i“l)“RK*5l('.(BB) 

DXY06300 

66* 


TlMc(i) = TT 

DXY06400 

67* 


ILXY - I 

DXY06500 

68* 


Go TO 10 

DXY06600 

69* 

20 

RK = ( (ZM-Z(I) )/(2(I+l)-Z(I) )*0,5 *(UBaR(I+1)“UBaR(I))+UBAR(I)) 

DXY06700 

70*' 


IF (NORMAL ,Evi, 1) GO TO 25 

DXY06800 

71* 


RK = RK»(ZM-2(I) )+uF 

DXY06900 

72* 


ZF = ZF+(ZM“Z(D) 

DXY07000 

73* 


RK = RK/ZF 

DXY07100 

74* 

25 

Rk = RK*(TSTR-TT) 

DXY07200 

75* 


Bb s WU ( I+l ) "WD ( I ) 

DXY07300 

76* 


IF (uB .GT* 180.0) Bb b 6B“360.0 

DXY07400 


77* 


IF (BB ,LT. -180,0) Bb = BB+360,0 

DXY07500 

78% 


Bb = AMOD(BB»36Q.O) 

DXY07600 

79* 


THETAM = BB/(2(I+1)-Z(I) )*(ZM-Z(I))+WB(I) 

DXY07700 



THETAK = 0,5*(ThETaM+WC(I) ) 

DXY07800 

bl* 


IF (ABS(THETAFi-lfltD(I) ) ,GT, 180,0) THETAK = THETaK-180,0 

DXY07900 

b2« 


Bti = THETAK+PPI 

DXY08000 

83* 


DX(l) = DX(1-1)-RK*SIN(BB) 

OXY08100 

84’tc 


DY(I) = DY(l-l)-RK*COS(BB) 

OXY0B2O0 

85* 


TIMC<I) = T5TK 

DXY08300 

86* 


ILXy = I 

DXY08400 

87* 

28 

I = I + l 

OXY08500 

88* 


IF (I ,6E. NZS) 60 TO 30 

OXY08600 

89* 


RK = TSTR^0.5*(UBAR(I+1)+UBAR(I ) ) 

DXY08700 

90* 


ZF =; 0,5^iWUa+l)+WD(I) ) 

DXY08800 

91* 


IF (ABS(Wu(i+l)-WD(I) ) ,GT, 180,0) ZF = 2F-180.0 

DXY08900 

92* 


Bb = ZF*PPI 

OXY09000 

93* 


DX(I) = -RK*SIN(BB) 

DXY09100 

94* 


DY(1) = -KK*COS(BB) 

DXY09200 

95* 


TIMC(I) = TSTR 

DXY09300 

96* 


6u TO 28 

DXY09400 

97* 

30 

continue 

OXY09500 

98* 


I = NZS-1 

OXY09600 

99* 


QO 80 J =1»1 

DXY09700 

iQO* 


IF (DX(J)) 50,40.50 

OXY09800 

iui* 

40 

IF (DY(J)) 50.80.50 

DXY09900 

102* 

50 

Bb = 270,0-ATAN2(UY(J) .DX(U))*PPII 

DXYIOOOO 

i03* 


IF (BB ,GT, 360,0) BB = BB-360,0 

DXYIOIOO 

i04* 


IF (BB ,6T, 180,0) GO TO 60 

DXY10200 

a05* 


Bb = BB-t-180,0 

DXY10300 

i06* 


60 TO 70 

DXY10400 

107* 

60 

Bb = BB-180,0 

DXY10500 

AU8* 

70 

DX(j) = SORT(uX(J)*BX(J)+OY(J)*DY(J))-aO,5*(UBAR(J+1)+UBAR(J))* 

DXY10600 

109* 

KTStR-TIMC(J) ) 

DXY10700 

110* 


QY(o) = bb 

DXY10800 

ill* 

80 

CONTINUE 

DXY10900 

112* 


RETURN 

DXYllOOO 

ll3* 


END 

DXYlllOO 



1* 

z* 

3* 

SUBROUTINE UIST4, VERSION 5» REVISION 0 
subroutine CIST4(ISWS) 

DS400100 

4* 

COMMON /PLUME/ OC » A » B » C » HEAT » RHO » CP » P I » GAMMAX » GaMMAY t GAMMaZ f T (21 ) 

»DS400200 

5* 

1P121) »2(21) ,UBAR{21) fNZSfG(20) rQT,HM»SIGEP(21) »SlGAP(21) »6>TAUKf 

DS400300 

6* 

2N0RMAL » TV ( 2i ) r RH ( 21 ) » NAMC AS ( 12 ) ► NaMT ( 12 ) » SIGAR 

OS400400 

7* 

common /REST/ ZMrDPCZ»K»AlrBl»PHll»ZP»TZ»PZrPHl»lFLG»KS 

DS400500 

B* 

double precision U0»D1»D2»d3»D4,D5»D6 

DS400600 

9* 

data D1 » D2 f U3 » D4 » D5 » 06/4 . 98673470-2 » 2 , 1 1410061D-2 , 3 . 2776263D-3 , 

DS400700 

10* 

13 , 800360-6 » 4 • 68906D"5 1 5 . 363D-6/ 

DS400800 

11* 

IR (NORMAL .EQ. O) 60 TO 5 

DS400900 

12* 

06 = QC*(A*ZM**b+C) 

DS401000 

13* 

GO TO 6 

DS401100 

14* 

S QQ 5 OT 

DS401200 

15* 

6 IF (ISW8 .Eu« 1) GO TO 8 

DS401300 

16* 

Sw2l = 1.0/(GAMMAZ*2M*. 465116279) 

DS401400 

X7* 

Phi = 0,0 

DS401500 

16* 

GO TO 9 

0S401600 

19* 

8 S62l = 0,75/(GAMMAZ»ZM) 

DS401700 

20* 

Phi = 1.0/(3,0*(GAMMAZ*ZM)**2) 

DS401600 

21* 

ZTC = ZM*(1,0+GAMMAZ) 

DS401900 

22* 

ZbC = ZM*(1»0 -GaMMAZ) 

DS402000 

23* 

9 K = 1 

DS402100 

24* 

10 K = K+1 

DS402200 

25* 

IF (ISW8 .EO. 1) GO TO 61 

DS402300 

26* 

iflg = 0 

DS402400 

27* 

ZP = (Z(K)-ZM)*SQ2I 

DS402500 

26* 

IF (ZP) 20»15»30 

DS402600 

29* 

15 CONTINUE 

DS402700 

30* 

P<. = 0.5 

DS402800 

31* 

GO TO 60 

DS402900 

32* 

20 CONTINUE 

DS403000 

33* 

ZP 5 -ZP 

DS403100 

34* 

iflg = 1 

DS403200 

35* 

30 DO s 1.0-0.5*(1,0+ZP*(01+ZP*(D2+ZP*(03+ZP*{D4+ZP*(D5+ZP*D6))))))*»DS403300 

36* 

K-16) 

DS403400 

37* 

PZ = DO 

DS403500 

36* 

IF (IFLG .Eg, 1) PZ = 1.0-PZ 

0S403600 


♦ 

♦ 

* 

* 

1 4c 
* 
i4< 

1 4c 
'4c 
i4< 
14: 
14c 
.♦ 
!4c 
1 4c 
•4c 
)4c 
• 4c 
’4c 

1 4c 
1 4c 
,4c 

!♦ 

^4c 

^4c 

>4c 

>4: 


60 PIP = PZ-PHi 
GO TO 62 

61 PZP = 0.0 
2T - Z(K) 

2t> = Z(K-l) 

IP (ZB .GT. ZTC.OR.ZT ,LT. ZBC) GO TO 62 
IP (ZT ,GT, ZTC) ZT = ZTC 

IP (Zb ,Lf. ZbC) ZB = ZBC 

PZP = S02I4«( (ZT-ZB)-( (ZT-ZM)4c4c3-(ZB-ZiV|)4c4c3)4cPHI) 

62 Q(K-l) = PZP4CQQ 

*IF (Q(K-1> .LT, 0,0) O(K-l) = 0.0 

IF (ISW8 .EG. O.ANufO(K-l) ,LT. l.OE-20) G(i = 0,0 

IF (ISW8 .EG. 0) PHi = PZ 

IF (K ,LT, ImZ5) go to 10 

IF (NORMAL .EQ, 0) GO TO 90 

K = 2 

ZP z 2M 

70 IF (Z(K) ,G£, ZM) gO TO 80 
K = K+1 

IP (K .LE. NZS) go to 70 
GO TO 90 

60 IF (K .GT. NZS) GO TO 90 

Q(K-l) = QC4cA4c(Z(K)**b-ZP44cB)+Q(K-l) 

ZP z Z(K) 

K = K+1 
GO TO 80 
90 continue 

return 

END 


DS403700 

DS403800 

DS403900 

DS404000 

DS404100 

OS404200 

DS40430Q 

DS404400 

DS404500 

DS404600 

DS404700 

DS404800 

0S404900 

DS405000 

DS405100 

DS4Q5200 

DS405300 

DS405400 

DS405500 

DS405600 

DS405700 

DS405800 

D5405900 

QS406000 

DS406100 

DS406200 

DS406300 

DS406400 

DS406500 


SUBROUTiNfc dIST3» VERSION 5» REVISION 0 


I* 

2 * 


3* 

subroutine dIST3(1SW8) 

DS300100 

4>K 

COMMON /PLUME/ OC f A * B » C » HEAT » RHO » CP »P I r 6AMMAX , GaMMA Y p GAMMaZ » T ( 21 ) r DS300200 

5* 

lP(2l) »2(21) fUBAR(21) »N2S»Q(20) »QT,HM»SIGEP(21) fSl6AP(2l) »G»TAUK» 

DS30030Q 

6* 

2N0RmAL»TV(21) ,Rh(21) #NAMCAS(12) ,NAMT (12) »SI6AR 

DS300400 

7* 

common /Rest/ ZMfDPD2»K»Al»Bl»PHll»ZP»TZ»P2»PHI»lFL6»KS 

DS30050Q 

8* 

double precision D0rDlfO2,D3rD4,D5»D6 

DS300600 

9* 

data Dl'f D2 » D3 » D4 r D5 » D6/4 , 9867347D-2 f 2 , 114100610-2 , 3 . 2776263D-3 , 

DS300700 

10« 

13.80036t)-5»4,88906D-5»5.383D-6/ 

DS300800 

U* 

IF (NORMAL .Eli. 0) GO TO 2 

DS300900 

12* 

QO = QC*(A*2M**BK) 

DS301000 

X3* 

GO TO 3 

OS3011O0 

14« 

2 QO = QT 

DS301200 

15<K 

3 CONTINUE 

DS301300 

16>ti 

IF (ISW8 .Ne. 1) GO TO 4 

OS301400 

17* 

ZTC s ZM*(1,0 +GAMMaZ) 

DS301500 

le* 

Z6C s 2M*(1,0-GAMMA^) 

OS301600 

19* 

GO TO 35 

DS301700 

20* 

4 CONTINUE 

DS301800 

21* 

IFLO = 0 

DS301900 

22* 

ZP s (HM-ZM)/(6AMMAZ*2M*. 465116279) 

DS302000 

23* 

PZ = 0.5 

DS302100 

24* 

IF (ZP) 5,40.10 

DS302200 

25* 

5 continue 

DS302300 

26* 

ZP = -ZP 

DS302400 

27* 

IFLG s 1 

DS302500 

28* 

10 DO = 1,0-0.5*(1,0+2P*(D1+2P*(D2+ZP*(D3+2P*(D4+2P*(D5+2P*D6))))))**DS302600 

29* 

K-16) 

DS302700 

30* 

PZ s DO 

DS302800 

31* 

IF (IFLG .EQ, 1) PZ = l.O-PZ 

DS302900 

32* 

GO TO 40 

DS303000 

33* 

35 PZ = O.O 

OS303100 

34* 

ZT = HM 

DS303200 

35* 

ZB = Z(l) 

DS303300 

36* 

IF (ZT ,GT. ZBC) GO TO 36 

DS303400 

37* 

print 1000 

DS303500 

38* 

1000 format (38H0*** WARNING CLOUD IS TOTALLY ABOVE HM/) 

OS303600 


39« 

40>l> 

41+ 

42* 

43 » 

44» 

45k 

46k 

47k 

48k 

49K 

bOK 

blK 


60 TO 40 DS303700 

36 IP (2B ,UT. ZTC) GO TO 37 DS303800 

print 1001 DS303900 

1001 format (56H0KKK WaR^HMG CLOUD IS TOTALLY BELOW LOWER LAYER BOUNDARDS304000 
lY/) DS304100 

GO TO 40 OS304200 

37 IF (2T ,6T. ZTC) ZT = ZTC DS304300 

IF I ZB ,LT. ZDC) ZB = ZBC DS304400 

PZ = 0,75/(6AMMaZkZM)k( (ZT-ZB)-{ (ZT-ZM)kk3-(ZB-ZM)kk3)»1,0/(3,0k DS304500 

1(GAMMAZkZM)kk2) ) DS304600 

40 Oil) = PZ*Qq OS304700 

RETURN DS304800 

END DS304900 


cn 

to 



I* 

a* 

3 * 

4* 

5 * 

6 * 

7* 

6 * 

9 * 

10 * 

n* 

12 * 

13* 

14* 

15* 

16* 

17* 

18* 

19* 

20 * 

21 * 

22 * 

23* 

24* 

25* 

26* 

27* 

28* 

29* 

30* 

31* 

32* 

33* 

34* 

35* 

36* 

37* 

38* 


SUBROUTINE CONVi VERSION 5» REVISION 0 

subroutine cONV(Qf I»J»K) 
dimension ICHARU2) 

data ICHAR/lH0»lHl»lH2*lH3rlH4»lH5»lH6,lH7»lH6»lH9»lH+»lH-/ 
R = 0.0 
IP = 0 

K = lOHAR(ll) 

IP (Q) 100»55.10 
10 IF (Q-l.O) 20f30»40 

20 IP = 0 
R = Q 

21 IF (R .GT. 1.0) GO TO 50 
IP = IP-1 

R = R*10.0 
60 TO 21 
30 R = Q 
IP s 0 
60 TO 55 

40 IP = 0 
R z Q 

41 IF (R ,LT. 10,0) GO TO 50 
IP z lP+1 

R z R*0,1 
60 TO 41 
50 CONTINUE 

0 z R 

K z ICHaRUD 

IF (IP .LT. 0) K z ICHAR(12) 

55 I z IABS(IP/10) 

J z IABS(IP)-I*10 
60 DO 70 Lzl»10 

IF (I .NE, L-1) GO TO 70 

1 z ICHAR(L) 

60 TO 71 

70 CONTINUE 
60 TO 110 

71 CONTINUE 


CNVOOlOO 

CNV00200 

CNV00300 

CNV00400 

CNV00500 

CNV00600 

CNV00700 

CNV00800 

CNV00900 

CNVOIOOO 

CNVOllOO 

CNV01200 

CNV01300 

CNV01400 

CNV01500 

CNV01600 

CNV01700 

CNV01600 

CNV01900 

CNV02000 

CNV02100 

CNV02200 

CNV02300 

CNV02400 

CNV02500 

CNV02600 

CNV02700 

CNV02800 

CNV02900 

CNV03000 

CNV03100 

CNV03200 

CNV03300 

CNV03400 

CNV03500 

CNV03600 



^9* 


DO 80 UslflO 

CNV03700 

40* 


IF (J .NE, L-1) GO TO 80 

CNV03800 



J = ICHAR(L) 

CNV03900 



GO TO 81 

CNV04000 


80 

CONTINUE 

CNV04100 

44* 


60 TO 110 

CNV04200 

45* 

81 

CONTINUE 

CNV04300 

46* 

90 

RuTuRN 

CNV04400 

47* 

lUO 

print 2000» Q 

CNV04500 

46* 


GO TO 90 

CNV04600 

49* 

110 

print 2001» 0 

CNV04700 

t>04( 


GO TO 90 

CNV04800 

bl* 

2000 

format (39H ♦-♦lRROR*-* SOURCE STRENGTH NEGATIVE =»E15,8) 

CNV04900 

b2* 

2001 

format (47H ♦-♦error*-* POWER OF 10 ON Q TOO MANY DIGITS z»E15,8) 

CNV05000 

b3« 


END 

CNV05100 


cn 

42 *. 



1* 

2* 


SUBROUTINE uIM34» VERSION 5» REVISION 0 
subroutine UIMSh 

D3400100 

44c 


common /PUUME/ OC » a » B » C » heat t KHO » CP r P 1 f GAMMAX »GaMMA Y » GAMMaZ » T ( 21 ) 

.D3400200 

5* 

lPl2i) »2(21) rUbAH(2l) fWZSf6(20) »QT»HM»SI6EP(21) rSlGAP(2l) »6»TAUKf 

D3400300 

6* 

2NuHmAI-»TV( 21) ,Rh(2l) h\AMCA5(12) ,NAMT ( 12) » SIGAR 

D3400400 

7* 


common /SXG/ SIGX0(20) »SIGYO(20) »SIGZO(20) rH 

D3400500 

b* 


CuMmON /REST/ 2|vi,UP0Z,K»Al,Bl»PHll»ZP»TZ»P2»PHl»lFLG»KS 

03400600 

9* 


XFdFLG .cO. 1) GO 10 30 

03400700 

10* 

c 

SuUrcE DIMEinSXOimS FOR MODEL 3 

03400600 

11* 


IF iZM ,LTf. HM-GAMMAZ*ZM) GO TO lu 

03400900 

12* 


SlGZO(l) = (HM-ZM+bAMMAZ*ZM) *,2325581 

03401000 

13* 


H S (HM+ZM-*OAMMmZ*2M)*0»5 

03401100 

14* 


GO TO 20 

03401200 

15* 

10 

SlG^Od) = GAiV|MaZ*ZM*. 465116279 

03401300 

16* 


H - 2M 

D3401400 

17* 

20 

Sa6x0(1) = GAiviMaX*2M*. 465116279 

03401500 

16* 


SiGYOd) = GAMMAY*ZN*. 465116279 

03401600 

19* 


IF (SIGZOd) ,G1, 0.0) GO TO 50 

D3401700 

20* 


H = 0,5*(hM-Z(1) ) 

03401800 

21* 


SXGZ0<1) = oAMMAZ*h*. 465116279 

03401900 

22* 


Go ]0 50 

03402000 

23* 

c 

source dimensions F^R model 4 

03402100 

24* 

30 

Du 40’K=2,N2S 

03402200 

25 * 


Zn = Z(K-i) 

03402300 

26* 


IF (K ,EQ. 2) Zk = C,0 

03402400 

27* 


Zl- = 0.5*<Z(K)-2K)+ZK 

D3402500 

28* 


IF (ZP ,GT, ZM) GO TO 35 

03402600 

29* 


SXO = ZM 

03402700 

30* 


Gu TO 36 

03402800 

31* 

35 

SXO = (2.0*ZM-ZP) 

D3402900 

32* 

36 

SYO = SX0*6aMMAY*. 465116279 

03403000 

33* 


SXO = SX0*GaMiViAX*. 465116279 

03403100 

34* 


IF (SYO .LT. O.U) SYO = 0.0 

03403200 

35* 


IF (SXO ,uT, 0,0) SXO = 0.0 

03403300 

36* 


IF (NORMAL ,EO. 0) GO TO 36 

03403400 

37* 


IF (ZP ,Lt. ZM) GO TO 38 

03403500 

36* 


IF (SXO ,uT. 93.0) GXO = 93,0 

03403600 




IF (SYO .LT, 93,0) bYO = 93.0 

D3403700 

‘+0* 

3a Siexo(K-i) = sxg 

03403800 


SI(3Y0(K-1) = SYO 

03403900 

42* 

Sie20(K^l) = 0.0 

03404000 

43* 

40 CONTINUE 

03404100 

44 * 

H = ZM 

03404200 

45 * 

bO RETURN 

03404300 

46 * 

END 

03404400 


U1 

05 




SUBKOUTINE -JPIp version 5, REVISION 0 


2« 



3* 

FUNCTION IPHn, BtCtOtg) 

TPZOOlOO 


TPZ s (A"B)*(C“B)/(A»£) 

TPZ00200 

5* 

RETURN 

TPZ00300 

6* 

END 

TPZOOHOO 


Ol 

<1 



1 * 

SubROUTiNt CPHI» VeHSiON 5, REVISION 0 


2* 



3* 

Function cPni(A»B) 

PHIOOlOO 

4* 

CPhi = A*U000.U/B)**0,266 

PHI00200 

5* 

Rt-TURN 

PHI00300 

(>* 

End 

PHI00400 


U1 

00 


X* 

z* 

s* 


Subroutine plumei, version 5» revision o 

SUBROUTINE PUUMEl 

PLIOOIOO 



common /PLUME/ QC » A » 8 r C » HEAT f RHO f CP r P I » GAMMAX , GaMMA Y » GAMMaZ » T ( 21 ) 

,PL100200 

5* 

lP(2i) rZ(21) ,UBAR(21) »NZSfQ(20) »QTfHM»SIGEP(21) »SIGAP(2X) »G»TAUKf 

PL100300 

6* 

2N0RMALfTV(2l) ,R h( 2D »NAMCAS(12) »NAMT(12) rSIGAR 

PL100400 

7* 


common /REST/ ZM»DPDZ»K»Al,BlrPHllfZP»TZ»PZ»PHl»lFLG»KS 

PL100500 

8* 

C 

plume rise FOR INSTANTANEOUS SOURCE 

PL100600 

9* 


A1 = 6.tl*0C*A*HEAT/(Rh0*CP*PI*GAMMAX*GAMMAY*GAMMAZ) 

PL100700 

10* 


B1 s 1.0/<4,0-B) 

PL100800 

11* 


K = 1 

PL100900 

iz* 

10 

K = K+1 

PLIOIOOO 

13* 

20 

CALL LEAST(ZfTV»DPQZ»Kf0r0.0»0.0) 

PLlOllOO 

14* 


IF (DPDZ .LTt 3.322E-4) DPDZ = 3.322E-4 

PL101200 

15* 


ZM = (A1/UPUZ)**B1 

PL101300 

16* 


ZM = (A1/A*(A*ZM**B+C)/DPDZ)**0,25 

PL101400 

17* 


IF (ZM ,Lfc. Z(K)) GO TO 30 

PL101500 

18* 


K = K+1 

PL101600 

19* 


IF (K .GT, NZS) go to 80 

PL101700 

iiO* 


GO TO 20 

PL101800 

81* 

30 

IF (Z(K)-ZM ,lE. 10.0) GO TO 70 

PL101900 

82* 


IF (DPDZ-3.328E-4) 35f70»35 

PL102000 

83* 

35 

CONTINUE 

PL102100 

84* 


ZP = Z(K) 

PL102200 

85* 

40 

ZP = ZP-10.0 

PL102300 

86* 


IF (ZP ,LT. Z(l)> GO TO 85 

PL102400 

87* 


TVP = TV(K)-TPZ(Z(K)»ZP»TV(K)»TV(K-1)»Z(K-1)) 

PL102500 

86* 


call least (Z r tv, DPD^'K- l.lrZPf TVP) 

PL102600 

89* 


IF (DPDZ .GT. 3.322E-4) GO TO 6o 

PL102700 

30* 


DPDZ = 3.322E-4 

PL102800 

31* 

bO 

ZM = ZP 

PL102900 

32* 


GO TO 70 

PL103000 

33* 

GO 

ZM = (A1/0PDZ)**B1 

PL103100 

34* 


ZM = (A1/A+(A*ZM**B+C)/DPDZ)**0.25 

PL103200 

35* 


IF (ZM ,GT. ZP) GO TO 50 

PL103300 

36* 


IF (ZM ,GT. ZP-10,0) GO TO 70 

PL 10 34 00 

37* 


IF (ZP ,6E. Z(K-l)) GO TO 40 

PL103500 

36* 


ZM = Z(K-l) 

PL103600 


40« 

41 * 

42 ^ 

43* 

44 * 

45 * 

46« 

47* 


C RETURN ZM And dpdz for instantaneous source 

70 IFL6 = 0 
00 TO 90 

C CANnOT calculate zm and dpdz 
80 IFLe = 1 

GO TO 90 
85 IFLG = 2 
90 return 

END 


PL103700 

PL103800 

PL103900 

PL104000 

PL104100 

PL104200 

PL104300 

PL104400 

PL104500 



1* 

2« 

3« 


SUBROUTINE PLUMt2» VERSION 5» REVISION 0 
subroutine PLUME2 

PL200100 

4« 


COMMON /PLUME/ OC » A » B f C f HEAT » RHO » CP f PI » 6 AMMAX » GaMMAY r GAMM aZ » T (21 ) 

.PL200200 

5* 

1P(21) pZ( 21) rUfcJAR(21) »NZSrQ(20) » QT»HKi» 5IGEP (21 ) » SiQAP (21 ) »TAUK » 

PL200300 

6« 

2N0RmAU»TV(21) ,RH(21) HnAMCAS(12) »NAMT(12) »SIGAR 

PL200400 

7* 


common /Rest/ ZM»DPDZ,K»Al,Bl»PHll»ZP,TZ»PZrPHI,lFLG»KS 

PL200500 

6* 

C 

PLUmE rise for continuous source 

PL200600 

9* 


ZSUM '= 0.0 

PL200700 

10* 


UBARS =0.0 

PL200800 

11* 


A1 = 6.0*UC*HEAT/(RHO*CP*PI*6AMmAX*GAMMAY) 

PL200900 

12* 


B1 = ,3333353 

PL201000 

IS* 


K s 1 

PL201100 

14* 

10 

K = K+1 

PL201200 

15* 

20 

call least ( Z » T V r DP qZ »K» 0»0,0f0.0) 

PL201300 

16* 


IF (DPDZ ,LT. 3.322E-4) DPDZ = 3.322E-4 

PL201400 

17* 


UBARS = UBARS+(Z(K)-Z(K-1) )*(UBaR(K)+UBAR(K-1) )*0,5 

PL201500 

16* 


ZSUm = ZSUM+Z(K)-Z(K-1) 

PL201600 

19* 


UBARK = UBArS/ZSUM 

PL201700 

20* 


ZM = (A1/(UbARK*DPOZ) )**B1 

PL201800 

21* 


IF (ZM ,LE. Z(K)) go to 30 

PL201900 

22* 


K = K+1 

PL202000 

23* 


IF (K ,GT, NZS) 60 TO 60 

PL202100 

24* 


60 TO 20 

PL202200 

25* 

30 

IF (Z(K)-ZM ,LE. 10.0) GO TO 70 

PL202300 

26* 


IF (DPDZ^3.322E-4) 35»70>35 

PL202400 

27* 

35 

CONTINUE 

PL202500 

26* 


UBARK = UBARS-(Z(K)-Z(K-1) )*(UBaR(K)+UBAR(K-1))*0,5 

PL202600 

29* 


ZBARK = ZSUM-(Z(K)-Z(K-1) ) 

PL202700 

30* 


ZP = Z(K) 

PL202800 

31* 

40 

ZP = ZP-10.0 

PL202900 

32* 


IF (ZP ,LT. Z(D) 60 TO 85 

PL203000 

33* 


TVP = TV(K)-TPZ(Z(K) »ZP.TV(K) »Tv(K-l) »Z(K-1) ) 

PL203100 

34* 


CALL least ( Z » tv f DPDZ » K-1 » 1 , ZP . TvP ) 

PL203200 

35* 


IF (DPDZ .GT. 3.322E-4) GO TO 6q 

PL203300 

36* 


DPDZ = 3.322E-4 

PL203400 

37* 

50 

ZM = ZP 

PL203500 

38* 


GO TO 70 

PL203600 





60 

U6ARZ = UaAK(K)-TPZ(Z(K) »2PrUBAR(K) »UBAR(K-X) »Z(K-1) ) 

PL203700 

40* 



U6ARZ = (OBaRK+(ZP-Z{K-X) )*(UBARZ+UBAR(K-^X) )*0.5)/(ZBaRK+ZP' 

-Z(K-1)PL203600 

4X* 


1) 

PL2 03900 

42* 



ZM : (AX/(UbARZ*DPL>Z) )>*=*BX 

PL204000 

43» 



IP (ZM ,6T, ZP) GO TO 50 

PL204X00 

44* 



IF (ZM ,GT, ZP-X 0 * 0 ) GO To 70 

PL204200 

45* 



IF (ZP ,6£* Z(K-X)) GO TO 40 

PL204300 

46* 



ZM z 2(K-X) 

PL204400 

47* 

C 


RETURN ZM AND DPDZ FOR CONTINUOUS SOURCE 

PL204500 

48* 


70 

IFLG = 0 

PL204600 

49* 



GO TO 90 

PL204700 

b04< 

C 


Cannot calculate zm and dpdz 

PL204800 

bX* 


60 

iflg - X 

PL204900 

b2# 



GO 10 90 

PL205000 

b3» 


8b 

XFL6 = 2 

PL205XOO 

b4« 


90 

RlTuRN 

PL205200 

b5* 



END 

PL205300 



X* 

SUBROUTINE aRU0S» VERSION 5 , REVISION 0 


3* 

FUNCTION ARuOS(A) 

ACSOOlOO 


AKCOS = ACOS(A) 

ACS00200 

5* 

RETURN 

ACS00300 

6 * 

EwD 

ACS00400 


a 

CO 



subroutine least r VERSION 5. REVISION 0 


i* 

2 * 

3* 

5* 
6 * 
7* 
64c 
9* 
10 « 
il* 
12* 
13* 
14* 
15* 
16* 
17* 
2 18* 
19* 
20 * 
21 * 
22 * 
23* 
2k* 
25* 
26* 
27* 
28* 
29* 


subroutine least ( 2 r T V , DPDZ » K » isw » ZP » TVP ) 
dimension Z(1),tVU) 

IF (K .UE. 1) 00 TO 30 

U = K 

TVB = 0,0 

Za s 0,0 

DO 10 I=1»K 

TVB = TVB+Tv(i) 

10 2t> s ZB+Z(I) 

IF (ISW ,£Q. 0) SO TO 15 
TvB = TVB+TVP 
Zb = Z0+ZP 
L = L+1 

IS TVB = TV8/Fl0aT(U 
Zb 5 ZB/FtOAT(L) 

51 = 0.0 

52 = 0,0 

DO 20 IrlrK 

SI = S1+(Z{I)-ZB)*(TV(I)-TVB) 

20 S2 = SZ-»-(Z(X)-2B)**ii 
IF USW ,£Q, 0) SO TO £5 

51 = S1+(ZP-ZB)*(TVP-TVB) 

52 = S2+(ZP-ZB)**2 
25 DPDZ = S1/S2 

30 CONTINUE 
RETURN 
END 


LSTOOlOO 

UST00200 

UST00300 

LST00400 

LST00500 

LST00600 

EST00700 

UST00800 

LST00900 

LSTOIOOO 

USTOllOO 

LST01200 

L.ST01300 

LST01400 

LST01500 

LST01600 

UST01700 

LSTOiaOO 

LST01900 

LST02000 

LST02100 

LST02200 

LST02300 

UST02400 

LST02500 

LST02600 

LST02700 



SECTION B 


USERS' INSTRUCTIONS FOR THE NASA/MSFC MULTILAYER 
DIFFUSION COMPUTER PROGRAM — VERSION 6 

B. 1 PROGRAM DESCRIPTION 

The NASA/MSFC Multilayer Diffusion Program — Version 6 is designed to 
calculate patterns of: 

• Concentration 

• Dosage 

• Time-mean concentration 

• Average cloud concentration 

• Time of cloud passage 

• Ground-level deposition due to precipitation scavenging 

• Ground -level deposition due to gravitational settling 

Program options include the calculation of concentration, dosage and time- 
mean concentration with partial reflection, with time dependent decay, and/or with 
depletion due to precipitation scavenging. Also, the Program is capable of calcu- 
lating ground -level gravitational deposition with partial reflection of material at 
the surface. Other program options include the printing of all data inputs, the 
printing of all model calculations, the plotting of concentration, dosage and/or time- 
mean concentration on the printer page, and the plotting of concentration, dosage 
and/or time-mean concentration on the SC4020 plotter at Marshall Space Flight 
Center, The program can be operated alone or with the Cloud-Rise Preprocessor 
Program described in Section A. 
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The NASA/MSFC Multilayer Diffusion Computer Program — Version 6 is 
written in FORTRAN IV and is designed for use on the Univac 1108 computer at 
Marshall Sjpace Flight Center, Huntsville, Alabama. The program requires 36, 000 
locations of core storage on the Univac 1108 computer. The FORTRAN source list- 
ing is shown in Section B. 5, and a complete list of program input parameters and pro- 
gram options is given in Section B.2 and B. 3. The program also requires mass 
storage units 9, 11 and 13 for use as scratch files. It is the users’ responsibility 
to assign these files, and they can be assigned the Univac 1108 default file size. Also, 
the user may optionally use mass storage file 10 and mass storage or tape file 12. 

If used, these files were created by tiie Cloud-Rise Preprocessor Program given in 
Section A. The assigning and managing of these files is, again, the users’ responsi- 
bilily. Files 10 and 12 are discussed further under NVHCLC and INUNT on data 
input card 1 in Section B.2. 

B. 2 PROGRAM INPUT PARAMETERS 


Each program input data deck consists of a case identification card followed 
by a namelist data deck, where the hamelist name is $NAM2. These data can be in 
ptmched card form or can be on mass storage and/or magnetic tape from the Pre- 
processor Program. The first data card of each case contains: 


Column 1 - Integer representing the vehicle for which the run 

(NVHCLC) is to be made 

1 = Titan me 

2 = Space Shuttle 

3 = Delta-Thor 2914 

4 = Minuteman II 

5 = Delta-Thor 3914 

Special Note - If Column 1 (NVHCLC) is input as zero or blank, 

the Program assumes that multiple cases have been 
stacked on mass storage unit 10 and magnetic tape 
or mass storage unit 12 by the Preprocessor Program. 
This Main Program will then execute all of the cases 
sequentially and automatically without any additional 
input. All variables on this one input card must be 
blank or zero 
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Column 2-1 
(METDTC) 

Column 8-J 
(NSNDC) 

Column 10- 
(NM0DLC) 


Column 13 
(NPLNTC) 


Column 79 
(INUNT) 


Six digit integer giving the month, day and year of 
the meteorological data. Pimch as M0DYYR, 


Hour of the meteorological sounding, right justified 
(00-24). 


•12 - Model number (right justified). If mass storage 
Preprocessor Program data is being used, make 
sure this data item and all others on this card are 
punched in the same way the Preprocessor has out- 
put and printed them. 


Number representing the pollutant. 

1 = HCl 

2 = CO 

3 = C02 

4 = AI2O3 

■80 - Data input logical unit number (right justified). If 

columns 79-80 (INUNT) are 5, the program assumes 
the remaining namelist ($NAM2) data cards are to be 
read from the card reader. If columns 79-80 are 
zero, blank or 10 the program assumes the data case 
described by the variables on this card was prepared 
by the Preprocessor Program and is to be found on 
random access mass storage unit 10 and mass storage 
or tape unit 12. The program will then search unit 
12 (directory) for this case to determine the location 
on unit 10 (inventory) where the case is to be found. 
The data is then initially read from unit 10 and at the 
completion of this read, will also read namelist 
$NAM2 from the card reader. This second read of 
the namelist data is for any updates to the main data. 

If there are no updates, include only a $NAM2 and 
$END card. At the completion of this case, the pro- 
gram will cycle around for a new case card only if 
the variable NPS in namelist $NAM2 below is zero. 
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The namelist data variables are read after the case identification card and 
only if column 1 (NVHCLC) is not zero and not blank. The namelist format is given 
in Section B. 4 for those users not familiar with namelist input. 

NAMCAS - 72 Hollerith characters of general case identification informa- 

tion. This information is printed in addition to the adjusted 
cloud stabilization height, range and azimuth bearing and the 
date and time of the run as a title page to the output listing. 

TESTNO - The first 36 Hollerith characters (TESTNO (1) - TESTNO (6) 

contain the meteorological case information. This information 
is printed in the page heading and plot titles following the words 
"THE METEOROLOGICAL CASE IS". 

Characters 37 through 60 (TESTNO (7) - TESTNO (10) contain 
the name of the rocket vehicle for use in the page heading, (e. g. 
TITAN niC) 

Characters 61 through 72 (TESTNO (11) - TESTNO (12) contain 
the name of the pollutant only if it is not HCl, CO, CO2, or 
AI2O3. (e.g. NOx). 

NFS - This parameter is used to indicate multiple cases. 

If NFS is set to 0, Ihe Frogram assumes there is another case 
to follow and cycles to read the next case identification card 
(data card 1). 

If NFS is set to 1, the Frogram assumes this is the last case 
to process and summarizes all cases processed at the end of 
the output listing and stops. 

ISKIF - Frogram control option array. 
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ISKIP (1) - This option, if set non-zero, indicates patterns of concentra- 

tion, dosage, time-mean concentration, deposition, etc. are to 
be calculated and printed on the polar reference grid system 
defined by XX and YY below. The grid system origin is the 
vehicle launch site and all calculation distances are relative 
to the origin. This option is the ISW(12) option in the Preprocess- 
or Program. 

ISKIP (2) - This option, if set non-zero, is used to calculate maximum center- 

line values of concentration, dosage, time-mean concentration, 
and/or deposition along the cloud trajectory relative to the launch 
site. This option is the ISW(13) option in the Preprocessor Pro- 
gram. 

If ISKIP (2) is set equal to 1, the model calculations are printed. 

If ISKIP (2) is set equal to 2, the model calculations are plotted. 

If ISKIP (2) is set equal to 3, the model calculations are both 

printed and plotted. 

The maximum centerline concentration, dosage, time-mean 
concentration and deposition are determined by the use of a 
spline function. At each radial distance (XX) from the origin, 
the Program determines a curve via the cubic spline that passes 
through each angular (azimuth bearing YY) grid coordinate with 
the calculated maximum roughly in the midpoint of the curve. 

The Program will then determine the maximum value and out- 
put, the range and azimutii bearing to that maximum 


ISKIP (3) - This option, if set non-zero, is used to calculate isopleths of 

concentration, dosage, time-mean concentration and/or depo- 
sition. This option is the ISW(14) option in the Preprocessor 
Program. 
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If ISKIP (3) is set equal to 1, the isopleths are printed. 

If ISKIP (3) is set equal to 2, the isopleths are plotted. 

If ISKIP (3) is set equal to 3, the isopleths are both printed and 

plotted, 

ISKIP (4) - This option is used only with the calculation of ground -level 

precipitation deposition (Model 5). This option is the ISW(ll) 
option in the Preprocessor Program, 

If ISKIP (4) is set non -zero, the maximum possible ground -level 
precipitation deposition is calculated at points downwind from the 
cloud position. These calculations are independent of the elapsed 
time from TlMl to the calculation point. 


If ISKIP (4) is set equal to zero, the calculated precipitation 
deposition at points downwind from the cloud position at time 
TlMl is dependent upon the elapsed time from TlMl to the points. 

ISKIP (5) - This option controls the pollutant name and units printed in the 

page heading and plot legend; 

If ISKIP (5) is set equal to 1, the units of calculated HCl concen- 
tration are in parts per million (ppm) and dosage units are in 
parts per million seconds. If HCl precipitation deposition is 
being calculated (Model 5), the units of deposition are pH (sur- 
face water acidity) or milligrams per square meter depending 
on ISKIP(9) below. 

If ISKIP (5) is set equal to 2, the units of calculated CO concen- 
trations are in parts per million (ppm) and dosage units are in 
parts per million seconds. 
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If ISKIP (5) is set equal to 3, the units of calculated CO concen- 
trations are in parts per million (ppm) and dosage units are in 
parts per million seconds. 

If ISKIP (5) is set equal to 4, the units of calculated A1 O con- 

323 

centration are in milligrams per cubic meter (mg/m ) and 
dosage units are in milligram seconds per cubic meter. 

If TESTNO (11) above is non-blank, then ISKIP (5) is used only 
for units selection and the pollutant name is taken from TESTNO 
(11). Also, calculated gravitational deposition (Model 6) is in 
units of milligrams per square meter. 

ISKIP (6) - This option is used for printing purposes only and gives the 

type of vehicle launch for which calculations are being made 
and inserts the following in the page heading and plot legend. 

If ISKIP (6) is set equal to 1, a "STATIC FIRE" is assumed. 

If ISKIP (6) is set equal to 0 or 2, a "NORMAL LAUNCH" is 

assumed. 

If ISKIP (6) is set equal to 4, a "SLOW BURN" is assumed. 

If ISKIP (6) is set equal to 5, the program omits this option from 

the page heading and plot legend. 

ISKIP (7) - This option controls the meteorological data used with Model 4. 

If ISKIP (7) is set equal to zero, the Program assumes Model 
4 is being used to determine concentration, dosage, etc. , in a 
layer where the pollutant distribution at cloud stabilization 
varies substantially with height. The meteorological data used 
in Model 4 is automatically determined from ihe meteorological 
inputs assigned to the initial layers or sublayers. 
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ISKIP (8) 


ISKIP (9) 


NXS 


NYS 


If ISKIP (7) is set equal to 1, the Program assumes Model 4 is 
being used to determine concentration, dosage, etc. , resulting 
from changes in the meteorological layer structure. The meteo- 
rological data used in Model 4 after time TAST (time of layer 
structure change measured from time of cloud stabilization) is 
taken from the input parameters ALPHL through TEMPL . 


This option. If set non-zero, prints a detailed listing of all 
Program inputs. 

If set to zero, output of precipitation deposition (Model 5) is 
assumed in milligrams per square meter. 

If set to 1, output of precipitation deposition for HCl only is 
assumed in pH (surface water acidity). If ISKIP (9) is set to 1, 
all calculation and program output assumes that 0 is the maxi- 
mum possible pH and 14 is the minimum possible pH in teims of 
acidity. 

Number of radial distances (range) XX in the polar reference 
grid system. If NXS is set < 0, the default value of 41 is used 
for NXS and the array XX is automatically filled from values 
shown in Table B-3. 

Number of aximuth bearii^s in the polar reference grid system. 

If NYS is set < 0, this parameter is automatically calculated 
and the array of azimuth bearing coordinates (YY) is automatically 
filled. The value of NYS includes sufficient points in YY to pro- 
vide a calculation pattern spanning 100 degrees (see Table B-3, 
note 9). 
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NZS 


NCI, NDI, 
NTI 


NPTS 


NVS 


Total number of initial layer boundaries including the ground 
surface boundary. 

These parameters each contain two values used in the maximum 
centerline calculations under ISKIP(2) and in the calculation of 
isopleths under ISKIP(3). 

The total number of isopleth values is given in the hundreds and 
tens positions of NCI, NDI and/or NTI, If these positions are 
zero, isopleths for the respective quantity (concentration, dosage, 
time-mean concentration and/or deposition) is not calculated. 

The number of critical pollutant levels (air quality standards) to 
be identified in the plots for maximum centerline calculations is 
given in the units position of NCI, NDI and/or NTI. If this posi- 
tion is zero, no plot is generated. If set to 9, a plot is generated 
without indicators for critical pollutant levels (air quality stan- 
dards) . 

If the units position of NCI, NDI and/or NTI is greater than zero 
and not equal to 9, the critical pollutant levels (standards) must 
be punched as the first values in the arrays Cl, DI and/or TI 
below. 

Number of heights at which calculations are to be made. If 
NPTS is set equal to zero or omitted, NPTS is defaulted to 1 and 
ZZL (1) below is set equal to zero. 

Number of droplet or particle terminal fall velocities used to 
calculate ground-level gravitational deposition from all layers 
except the layer in which a destruct occurs (Model 6 only). 
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NVB 


XX 


YY 


Z 


DELX 


Number of droplet or particle terminal fall velocities used to 
calculate ground-level gravitational deposition from the layer in 
which a vehicle destruct occurs (Model 6 only). 

Array of radial distances (range) for the coordinates used in 
calculations on ihe reference grid system. This array is auto- 
matically filled if NXS = 0, (see NXS above). The last 2 points 
in XX are used only for calculating isopleths; the second to last 
point should equal 1. 2 times the third to the last point and the last 
point should equal 1. 5 times the third to the lastpoint. Space the 
XX values uniformly and use as many as the program will allow. 
The user is cautioned to use the default values unless another 
grid is required. 

Array of azimuth bearings for the coordinates used in calculations 
on the reference grid system measured clockwise from zero de- 
grees north. This array is automatically filled if NYS = 0 (see 
NYS above). Space the YY values densely toward the center of 
the calculation sector and use as many as the program will allow. 
The user is cautioned to use the default values unless another grid 
is required. 

Array of layer boundary heights in ascending order beginning with 
the surface boundary height (the first layer is always the surface 
layer). 

Array of the radial distances (range) from the source location 
(pointiof cloud stabilization) in each layer to the center of the 
reference grid system (launch site). 
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DELY - Array of azimuth bearings to the source location (point of cloud 
stabilization) in each layer, measured clockwise from zero de- 
grees north. 

Q - Source strength within each initial layer. The source strength 

input units depend upon the model used and the pollutant for which 
calculations are being made. Table B-1 gives the appropriate 
input units for each model pollutant combination. 

UBARK - Mean wind speed at ZEK followed by the mean wind speed at the 
top of each layer. 

SIGAK - Standard deviation of the wind azimuth angle for reference time 

T at ZRK followed by the standard deviation of the wind azimuth 
oK 

angle at the top of each layer. 

SIGEK - Standard deviation of the wind elevation angle at ZRK followed by 
the standard deviation of the wind elevation angle at the top of 
each layer. 

SIGXO - Standard deviation of tiie alongwind concentration distribution of 
the source in the layer (alongwind source dimension). 

SIGYO - Standard deviation of the crosswind concentration distribution of 
the source in the layer at a downwind distance XLRY from the 
true source (crosswind source dimension). The default value is 
SIGXO. 

SIGZO - Standard deviation of the vertical concentration distribution of the 
source in the layer at a downwind distance XLRZ from the true 
source (vertical source dimension). 
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TABLE B-1 

SOURCE STRENGTH INPUT UNITS 


Model 

Pollutant 

HCL, CO, COg 

AL 2 O 3 

1 

1 

2 

2 

1 

2 

3 

1 . 

2 

4 

1 

2 

5 

2 * 

2 

6 

2 

2 


Code definition for Table B-1: 


• (D 


Q = Q’ 


22.4 

M 


T 1013.2 
273. 16 P 


(Concentration output units are parts per million (PPM) 


• (D Q = Q’ 

where 

Q = Source strength in each initial layer 
Q' = Total weight of the material in the layer in milligrams 
T = Surface temperature in degrees Kelvin 
P = Surface pressure in millibars 
M = Molecular weight of the material 

*If HCl precipitation deposition (Model 5) in pH units is being calculated, then 
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TABLE B-1 (Concluded) 


Q 


= (q’ 


X 10~^ X 




25.4 


Mole. Wt. (gr) duration (hr) 


) 


or for maximum HCl precipitation deposition in pH units 

Q = (q' X 10 x j— X 25.4 ^ Mole. Wt. (gr) ) 

\ hr./ 

(Deposition output units for Model 5 is milligrams per square meter (mg/m^). How- 
ever, deposition output can be in pH units for HCl depending on ISKIP(9).) 

, 2 

Deposition output units for Model 6 is milligrams per square meter (mg/m ) and 
concentration output units for Models 1 through 4 are milligrams per cubic meter 
(mg/m ). 
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ALPHA - Lateral diffusion coefficient in the layer (default value is 1). 

BETA - Vertical diffusion coefficient in the layer (default value is 1). 

ZRK - Reference height in the surface layer for meteorological meas- 

urements (default value is 2 meters) . 

TEMPK - Virtual potential temperature at each layer boundary z. This 

parameter is used only in the calculation of the wind speed shear 
in the layer. If the wind speed shear is negative and the differ- 
ence between the virtual potential temperature at the top and 
bottom of the layer is also negative, the Program will use the 
absolute value of the speed shear. If the temperature difference 
is positive or zero, the program will use a wind speed shear of 
zero. If the layer wind speed shear is positive or zero, the vir- 
tual potential temperature difference is not used, 

TIMAV - Time over which time-mean concentration and average cloud con- 
centration are calculated (default value is 600 seconds except for 
CO, where it is 300 seconds). 

THETAK - Mean wind direction at ZRK followed by the mean wind direction 
at the top of each layer. 

TAUK - Time required for cloud stabilization 

TAUOK - Reference time for the standard deviations of the wind azimuth 
angle SIGAK (default value is 600 seconds). 

H - Adjusted cloud stabilization height. 
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XRY - Distance downwind from a virtual point source over which recti- 

linear expansion in the lateral occurs (default value is 100 meters). 

XLRY - Reference from the true source at which SIGYO is measured (de- 
fault value is zero). 

XLRZ - Reference distance from the true source at which SIGZO is mea- 
sured (default value is zero). 

ZZL - Vertical calculation heights. This parameter can include any 

heights within the initial layer structure (default value is zero). 

IZMOD - This parameter designates the model number or numbers for use 

in each input layer. A brief description of the six Program models 
is given below and a complete mathematical description of each 
model is given in Section 3 of the main body of the report given 
in the introduction. The possible model number combinations 
input into IZMOD are given in Table B-2. 

1 - Model 1, the source extends vertically through the entire in- 

itial layer and turbulent mixing is occurring. It is assumed 
that the vertical distribution of material is uniform with 
height and the distributions of material along the along -wind 
and the crosswind cloud axes are Gaussian. The digit 1 
is included in the array IZMOD for each layer in which Model 
1 is to be used. Also, if any digit of IZMOD is 0, the Program 
assumes Model 1 has been designated. 

2 - Model 2 refers to the same source configurations as Model 1 

in that the source extends vertically through the entire depth 
of the layer and the distribution of material is uniform with 
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TABLE B-2 


POSSIBLE INPUT MODEL NUMBER COMBINATIONS 


IZMOD ^ 

PROGRAM ASSUMES CALCULATIONS ARE MADE USING: 

0 

Model 1 

1 

Model 1 

2 

Model 2 

3 

Model 3 

14 

Model 1 is used prior to layer transition and Model 4 is 
used after layer transition occurs at time TAST 

24 

Model 2 is used prior to layer transition and Model 4 is 
used after layer transition occurs at time TAST 

34 

Model 3 is used prior to layer transition and Model 4 is 
used after layer transition occurs at time TAST 

4 

Model 4 is used to accomodate to a variation of source 
strength in the layer and layer transition is immediate 
(TAST=0) 

5 

Model 5 is used and the layer structure and source dis- 
tribution is assumed to be that of Model 1 when only the 
digit 5 is given in IZMOD. The digit 5 can be com- 
bined with any of the above digit combinations (145, 45, 
35, etc. ). When a 5 is combined with any of the above 
digit combinations the Program assumes the layer struc- 
ture and source distribution of that combination are used 
with Model 5. 

6 

Model 6 


The digits under IZMOD can appear in any order. For example, 
14 is the same as 41 and 154 is the same as 415. 
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height. In Model 2, however, it is assumed that no turbu- 
lent mixing is occurring. The digit 2 is included in the 
array IZMOD for each layer in which Model 2 is to be used 
in the calculations (IZMOD = 2, 2, 2, etc. ). 

3 - Model 3 differs from Models 1 and 2 in that the vertical ex- 

tent of the source is less than the depth of the layer. The 
model equation thus contains vertical expansion terms. The 
digit 3 is input to IZMOD for Model 3 (IZMOD = 3). 

4 - Model 4, the layer-transition model, may be used to cal- 

culate concentration and dosage resulting from changes in 
the meteorological layer structure. Model 4 may also be 
used to calculate concentration and dosage in a layer where 
the pollutant distribution at cloud stabilization varies sub- 
stantially with height. 

The application of Model 4 requires the following assumptions: 

• The boundaries between adjacent initial layers or sublayers is 
eliminated (at time TAST) and the layers are replaced by a single 
layer 

• Turbulent mixing is occurring in the resultant single layer 

• The material in each of the initial layers or sublayers is (before 
time TAST) uniformly distributed in the vertical 

• Reflection occurs at the upper and lower boundaries of the re- 
sultant single layer 
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- Model 4, the layer-transition model, may be used to calculate 
concentration and dosage resulting from changes in the 
meteorological layer structure. Model 4 may also be used 
to calculate concentration and dosage la a layer where the 
pollutant distribution at cloud stabilization varies substan- 
tially with height. 

The application of Model 4 requires the following assumptions: 

• The boundaries between adjacent initial layers or sublayers is 
eliminated (at time TAST) and the layers are replaced by a single 
layer 

• Turbulent mixing is occurring in the resultant single layer 

• The material in each of the initial layers or sublayers is (before 
time TAST) uniformly distributed in the vertical 

• Reflection occurs at the upper and lower boundaries of the resultant 
single layer 

If the parameters TAST and ISKIP (7) are both set to zero (or omitted from 
the inputs) and Model 4 is specified for use, the program assumes the function of the 
model is to accommodate variations in the pollutant distribution with height in the 
layer at cloud stabilization. For example, the surface mixing layer can be initially 
divided into several sublayers where the source strength, although assumed to be 
vertically uniform in each sublayer, varies from layer to layer. In this case the 
initial layers are immediately reduced to a single layer and Model 4 calculates the 
contribution from each of the initial sublayers to the composite concentration and 
dosage field by permitting turbulent mixing across the initial layer boundaries. 

IZMOD would contain the digit 4 for each of the respective initial sublayers that 
comprise the resultant single layer. 
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If Model 4 is to be used to predict the concentration and dosage fields 
dovrawind from a change in meteorological structure, the meteorological parameters 
of the new resultant layer or layers must be specified. Also, the parameter 
ISKIP (7) must be set equal to 1 and the parameter TAST set equal to the time (after 
cloud stabilization) at which the layer transition (meteorological structure change) 
occurs. Each of the initial sublayers that are to be included in a single layer after 
layer transition are specified by including the digit 4 in the array IZMOD. For 
example, assume layers 1 through 4 are to be reduced to a single layer after layer 
transition and layers 5 and 6 are also reduced to a single layer. The first four 
values of IZMOD would include a 4, but they would also include the number of the 
model to be used prior to layer transition (14, 24 or 34). The values of IZMOD (5) 
and (6) for layers 5 and 6 would include a 9 and 4, respectively. The 9 is a special 
flag to separate the resultant 2 layers after layer transition. Also, these last two 
values would include the model number to be used prior to layer transition (14, 

24 or 34). If Model 1 was to be used with 4 in the above example the IZMOD inputs 
would be coded as IZMOD = 4, 4, 4, 4, 9, 4 (or IZMOD = 4*4, 9, 4, or IZMOD = 
4*14, 19, 14, etc.). 

5 - Model 5 is used to calculate the amount of material on 

the surface by precipitation scavenging. The digit 5 must 
be included in the array IZMOD for each initial sublayer 
through which precipitation is occurring. Model 5 uses the 
layer structure and source distribution defined by any one 
of Models 1 through 4. Thus, the array IZMOD must 
include the appropriate model number for each layer that 
describes the layer structure and source distribution. For 
example, assume that Model 4 is being used to accommodate 
to variations in the pollutant distribution with height in the 
surface mixing layer at cloud stabilization and that the 
surface mixing layer has been divided into 6 initial sub- 
layers in which the distribution of material can be 
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considered uniform. Also, assume that precipitation is 
occurring through all 6 layers. The array IZMOD would 
then contain six values equal to 45 for each layer 1 through 
6 (IZMOD = 6*45). 

6 - Model 6 is used to calculate the surface deposition due to 
gravitational settling. The basic source configuration is 
a volume source of finite lateral extent and unit vertical 
extent. Other source configurations are treated by summing 
the deposition at the ground resulting from a number of 
basic sources arranged to simulate the desired configuration. 
The model is essentially a tilted plume model in which the 
effects of wind shear are taken into account. The axis of a 
particle or droplet cloud of a given settling velocity inter- 
sects the ground plane at a distance from the source and at 
an angle from the mean surface wind direction that are 
proportional to the total angular wind shear and the residence 
time of the settling material in the layers between the source 
and the ground surface. In any layer, the inclination of the 

cloud axis from the horizontal is given by tan ^ V / u, 

s 

where V is the particle or droplet settling velocity and u 
s 

is the mean transport wind speed in the layer. In all cases, 

th 

material released in the K layer and dispersed upwards by 
turbulence is assumed to be reflected downward at the inter- 
face of the and (K + 1)^^ layers. The basic model is used 
to calculate the ground-level deposition pattern for a single 
value of the settling velocity. The total deposition pattern 
is obtained by summing the results for all settling velocities 
representative of the particle or droplet-size distribution of 
the released material on a reference coordinate gprid system. 


84 


Only IZMOD (1) need be set equal to 6 as no other model 
can be executed in the same case. 


DECAY 


ZLIM 


BLAMDA 


TIMl 


Coefficient of time-dependent decay. If DECAY is set > 0, then 
concentration, dosage, time-mean concentration, etc. , are 
calculated with decay (Does not effect Model 5 or Model 6). 

This parameter is the maximum height through which precipitation 
can occur. If Model 5 is selected, ZLIM is automatically deter- 
mined from IZMOD. If concentration, dosage, etc. , are being 
calculated with precipitation occurring (BLAMDA > 0. 0), 

ZLIM is equal to the upper boundary of the uppermost layer in 
which precipitation occurs (ZLIM is defaulted to Z(NZS)). 


Precipitation scavenging (washout) coefficient. If Model 5 is 
selected, this parameter must be greater than 0. Also, if Model 
1, 2, 3 or 4 is selected with BLAMDA > 0 and without Model 5, 
the Program assumes concentration, dosage, etc, , are to be 
calculated with precipitation occurring. 


BLAMDA ^ 5.2 X 10 



0. 567 
sec 


Time of start of precipitation measured from the time of cloud 
stabilization. (Not used for maximum precipitation deposition). 


Cl, DI and TI - Arrays of concentration, dosage and time-mean concentration 
values respectively for which isopleths are calculated. There 
can be two groups of data in each of these arrays, where both 
of the groups are arranged in descending order. The values in 
the first group are critical pollutant levels (air quality standards). 
The number of values in this group is given in the units position 
of the parameters NCI, NDI and NTI respectively. The second 
group of values includes jill other Isopleth levels desired. The 
total number of values in Cl, DI and TI is given in the hundreds 
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TAST 


GAMMAP 


VS 


PERC 


ACCUR 


and tens positions of NCI, NDI and NTI respectively. If pre- 
cipitation, deposition or gravitational deposition is being calculated, 
the array DI is used for these quantities. 

Time of layer structure change (Model 4) measured from the time 
of cloud stabilization. 

This parameter is 1 minus the fraction of material reflected at 
the surface (partial reflection). If this parameter is set to 0, the 
Program assumes complete reflection; if set equal to .4, 60 per- 
cent (. 6) reflection is assumed; and, if set equal to 1, no reflection 
is assumed. If Model 6 is selected and partial reflection is 
desired, the array GAMMAP must have a value for each particle 
settling velocity category. For all other models, only GAMMAP (1) 
need be set. 

Droplet or particle terminal fall velocity distribution used in all 
layers except a layer in which a vehicle destruct occurs (Model 6 
only). 

Frequency of occurrence of each velocity category VS (Model 6 
only). 

Accuracy constant for the line source simulation used in Model 6. 

A value of 0. 45 ensures that the calculated ground deposition is 
within 10 percent of the deposition expected from a vertical line 
source. If ACCUR is set to 0.32, the calculated deposition is 
within 5 percent of that expected from a vertical line source. 
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VB 


PERCB 


SCL 


XMAXIN 


YMAXIN 


XSIZE 


YSIZE 


RASTIN 


Droplet or particle terminal fall velocity distribution used in the 
layer in which a vehicle destruct occurs. The layer must be the 
top layer (Model 6 only). 

Frequency of occurrence of each velocity category VB (Model 6 
only). 

Map scale factor in inches for isopleth plots. If the map scale 
factor is 1 inch = 24000. inches, SCL would be input as 24000. 

If set to zero, the Program will scale the isopleths within the 
boundaries defined by XSIZE and YSIZE below. 

Maximum alongwind distance from the launch site in meters for 
isopleth plots. If set to zero, the Program will use XX(NXS-2) 
as the maximum distance. 

Maximum crosswind distance for isopleth plots in meters. If 
set to zero, the Program will calculate YMAXIN. 

The number of raster counts on the SC4020 in the X or east -west 
horizontal plot axis for isopleths. If set to zero, the Program 
will use 937. 

The number of raster counts on the SC4020 in the Y or north- 
south vertical plot axis for isopleths. If set to zero, the Program 
will use 899. 

The number of raster counts per inch on the SC4020 for isopleth 
plots. If input as zero, the Program uses 163.2. 


87 



XCIZE 


YCIZE 


XMAXJN 


YMAXJN 


ISW 


JSW 


The number of raster counts on the SC4020 on the X or alongwind 
horizontal axis for maximum centerline plots. If set to zero, the 
Program uses 937. 

The number of raster counts on the SC4020 on the vertical axis 
for maximum centerline plots. If set to zero, the Program uses 
899. 

Maximum alongwind distance in meters from the launch site for 
maximum centerline plots. If set to zero, the Program uses 
XX(NXS-2). 

Maximum number of log cycles for the vertical axis of the 
maximum centerline plots if ISW, below equals 0 or 2. Maximum 
value of the vertical axis if ISW below equals 1. If set to zero, 
the Program determines YMAXJN. 

Maximum centerline plotting flag. If ISW is set to 0 or 2, the 
Program plots maximum centerline versus distance on a log-log 
plot. If set to 1, the plot is linear on both axes. 

Isopleth plot switch. If JSW is set equal to 0, the Program will 
fit a cubic spline function to the discrete isopleth points and plot 
a smooth curve through the points. If JSW is set equal to 1, the 
Program will not use the spline function but will plot straight 
lines between adjacent calculated isopleth points. This option 
has been included because the spline function sometimes fails to 
fit the data points when the isopleths are sharply curved. These 
cases are recognized by a high frequency oscillation along the 
plotted curve and can be corrected by smoothing the curve by 
hand or replotting with JSW set equal to 1. 
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The layer step change (transition) parameters below are used only if ISKIP (7) 

equals 1 and Model 4 has been selected. These parameters are used only when Model 

4 is being used to predict the concentration and dosage downwind from a change in 

meteorological structure (see IZMOD, Model 4 above). 

ALPHL - Lateral diffusion coefficient in each new layer (Default value is 1) . 

BETL - Vertical diffusion coefficient in each new layer (Default value is 1). 

TAUL - Time required for cloud stabilization in the new layers. 

TAUOL - Reference time for the standard deviation of the wind azimuth 

angle SIGAL in the new layers (Default value is 600). 

ZRL - Reference height in the surface layer for meteorological measure- 

ments. This must be set only if the new bottom layer includes the 
initial surface layer (Default value is 2). 

UBARL - Mean wind speed at the bottom and top boundaries of each new 

layer. These values are input in ascending order of new layers 
with the value at the top boundary preceded by the bottom. If the 
new bottom layer contains the initial surface layer, UBARL at ZRL 
should be input as the bottom value of this layer. 

SIGAL - Standard deviation of the wind azimuth angle for reference time 

^oL bottom and top boundaries of each new layer. If the 

new bottom layer contains the initial surface layer, SIGAL at 
ZRL should be input as the bottom value of this layer. 

THETAL - Mean wind direction at the bottom and top boundaries of each new 
layer. If the new bottom layer contains the initial surface layer, 
THETAL at ZRL should be input as the bottom value of this layer. 

TEMPL - Virtual potential temperature at the bottom and top boundaries of 

each new layer. . 
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B. 3 CONDENSED TABLE OF NAMELIST INPUT PARAMETERS 

The namelist data input parameters required for the NASA/MSFC Multi- 
layer Diffusion Program are given in condensed form in Table B-3. The informa- 
tion categories in the table are defined as follows: 


NAMELIST 

FORTRAN 

MODEL 

UNITS 

LIMITS 

VALUE 

ARRAY SIZE 


Name of the FORTRAN NAMELIST list to which the variables 
belong 

Fortran symbolic notation defining the program input 

Mathematical notation corresponding to the FORTRAN notation 

Dimensional units of the input parameters 

Numberical limits on input values 

Default value should the parameter have a value of 0 

Maximum number of core locations for the input parameter 
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TABLE B-3 

TABLE OP I^lPUT PARAMETERS 


NAMELIST 

: FORTRAN 

Model 

Units 

Limits 

Value® 

ArrJ^ 

Size(^ 

NAM2 

1 TESTNCi 

! N/A 

N/A 

N/A 

Blanks 

12 


; NAMCAS 

N/A 

N/A 

N/A 

Blanks 

12 


: ISKIP 

N/A 

N/A 

© 

0 

15 


NXS 

' N/A 

N/A 

-41 

41 

1 


NYS 

N/A 

N/A 

^41 

41 

1 


: NZS 

N/A 

N/A 

:S16 

0 

1 


: NDI 

' N/A 

N/A 

S103 @ 

0 

1 


NCI 

; N/A 

N/A 

S103 @ 

0 

1 


NTI 

1 N/A 

N/A 

S 103 @ 

0 

1 


NPTS 

N/A 

N/A 

o 

VI 

1 

1 1 


NVS 

N/A 

N/A 

520 

0 

1 ^ 


NVB 

N/A 

N/A 

o 

(M 

VI 

0 

1 


XX 

R 

Meters 

>0.0 

© 

41 


YY 

A 

Degrees 

0. 05<i. 
5360.0 


41 


NPS 

N/A 

N/A 

0 or 1 

0 

1 


Z 

z^, and z^, 
B1 TK 

Meters 

^0.0 

z(l)= 0.0 

16 


TABLE B-3 

TABLE OF INPUT PARAMETERS 


(Continued) 


NAMELIST 

FORTRAN 

Model 

Units 

Limits 

Value© 

ArriW 

Size© 

NAM2 

DELX 

R 

Meters 

SO. 0 

0.0 

15 


DELY 

A 

Degrees 

0.0 ^ 
:S360. 0 

0.0 

15 


Q 

Q 

© 

SO. 0 

0.0 

15 


UBARK 

^ “tk 

Meters 
Sec -1 

SO.l 

0.1 

16 


SIGAK 

‘'ar * 

‘'atk 

Degrees 

SO. 5 

0.5 

16 


SIGEK 

*^ER ^ *^ETK 

Degrees 

SO.l 

0.1 

16 


SIGX0 

0- {k} 

xo 

Meters 

>0.0 ! 

N/A 1 

' 1 

15 


SIGY0 

a {k} 

yo 

Meters 

>0.0 

SIGX0 1 

1 

15 


SIGZ0 

1 

0- {k} 

zo 

Meters 

SO. 0 

1 

1 

0.0 

15 


ALPHA 

i 

^ 1 

N/A 

S.0. 0 ' 

1.0 

15 


BETA 


N/A ! 

so. 0 

1 

1.0 

15 


ZRK 


Meters 

IV 

N 

1 2.0 ; 

1 1 


TIMAV 

Ta 

Seconds 

so. 0 

600 or 360 j 

1 


THETAK 

^ B1 ^ ^ TK 

1 

! Degrees 

O.O:20j^ 
^ 360. 0 

0.0 

16 




TABLE B-3 


TABLE OF INPUT PARAMETERS 


(Continued) 


1 NAMELIST 

FORTRAN 

Model 

1 Units 

Limits 

Value® 

Arr:w j: 

Size® j! 

NAM2 

1 TAUK 

T 

Seconds 

>0. 0 

N/A 

1 1 

1 

, TAU0K 

T 

1 0 

Seconds 

^0.0 

600.0 

1 


H 

H 

Meters 

2:0.0 

0.0 

1 


XRY 

i X 

Meters 

2:0. 0 

100.0 

1 



ry 






XRZ 

X 

Meters 

2:0.0 

100.0 

1 



! rz 






: XLRY 

"Ry 

Meters 

SO. 0 

0.0 

1 


j XLRZ 


Meters 

SO. 0 

0.0 

1 


ZZL 

z 

Meters 

SO. 0 

0.0 

1 


i IZM0D 

N/A 

N/A 

@ 

.1 

15 


' DECAY 

k 

Seconds ^ 

SO.O 

.0.0 

1 


. ZLIM 

^lim 

Meters 

”^TK 

Z(NZS)® 

1 


TIMI 


Seconds 

SO.O 


1 


BLAMDA 

A 

Seconds ^ 

SO.O 


1 


DI 


© 

SO.O 

® 

10 


Cl 


© 

SO.O 

® 

10 


TI 


© 

SO.O 

® 

10 










NAMELIST 

FORTRAN 

Model 

Units 

Limits 

Value® 

NAM2 

TAST 

t* 

Seconds 

IV 

o 

o 

0.0 


TEMPK 

4>£I & 

Degrees K 

>0.0 

0.0 


VS 

Vs 

Meters ^ 
sec“'^ 

>0.0 

© 


PERC 

fi 

N/A 

>0.0 

© 


ACCUR 

Rc 

N/A 

© 

© 


VB 

^SK 

Meters 

Sec"^ 

V 

o 

o 

® 


PERCB 

f . 
1 

N/A 

o 

o 

A 

© 


HB 

""SK 

Meters 

so. 0 

0.0 


GAMMAP 

l-7r 

N/A 

so & SI 

0. 0 


ALPHL 

“l 

N/A 

so.o 

@ 


BETL 


N/A 

so. 0 

Q 


TAUL 

T 

Seconds 

>0.0 

TALK 


TAU(^L 

T 

O 

Seconds 

IV 

o 

o 

TAU0K 


ZRL 

^RL 

Meters 

S2. 0 

ZRK 


UBARL 

^ BL ^ ^TL 

Meters 

Sec“^ 

SO.O 

@ 


SIGAL 

%BL < "o> 
“^ATL 0^ 

Degrees 

SO.O 

@ 


Array 

Size© 

5 

16 

20 

20 

20 

20 

20 

1 

20 

5 

5 

1 

1 

1 

10 

10 








TABLE B-3 


TABLE OF INPUT PARAMETERS 
(Continued) 


NAMELIST 

FORTRAN 

Model 

Units 

Limits 

Valued) 

Arr^ 

Size® 

NAM2 

SIGEL 

o'EBL ^ OETL 

Degrees 

>0.0 

® 

10 


THETAL 

0BL & ^tL 

Degrees 

>0.0 & 
<360.0 

@ 

10 


TEMPL 

4>bl & ‘^‘tl 

Degrees K 

>0.0 

0.0 

10 


SCL 

n/a 

Inches 

>0 

Calculated 

1 


XMAXIN 

R 

Meters 

>0 

Calculated 

1 


YMAXIN 

N/A 

Meters 

>0 

Calculated 

1 


XSIZE 

N/A 

Rasters 

>0 

937 

1 


YSIZE 

N/A 

Rasters 

>0 

899 

1 


R AST IN 

N/A 

Rasters/ 

Inch 

>0 

163.2 

1 


XCIZE 

N/A 

Rasters 

>0 

937 

1 

1 


YCIZE 

N/A 

Rasters 

>0 

899 

1 


XMAXJN 

N/A 

Meters 

>0 

XX(NXS-2) 

1 


YMAXJN 

N/A 

Log Cycles 
or Meters 

>0 

Calculated 

1 


ISW 

N/A 

N/A 

1 or 2 

2 

1 


JSW 

N/A 

N/A 

0 or 1 

0 

1 




TABLE B-3 


TABLE OF INPUT PARAMETERS 
(Continued) 


See Section B-2 for the range of values of the ISKIP options. 

Units depend on model; see Section B-2 in the definition of Q. 

The column under Value is used to simplify the Program input deck by providing default values 
should the parameter be intentionally omitted in the first data case or set to zero. All parameters 
in Table B-3 remain their previous value for all subsequent cases unless changed in the input 
list. 

Units of dosage and concentration isopleth values must be consistent with Program output units, 
milligram s/meter^ or parts per million, etc. 

These parameters must have values other than zero only if they are used by the model selected 
and only in the applicable layers. 

See Section B-2 for the description of ACCUR. 

Several variables are dimensioned to a larger value in the Program, but the extra space is used 
for other purposes. 



TABLE B-3 


TABLE OF INPUT PARAMETERS 
(ConcludecI) 

The default values of XX are: 500, 1250, 2500, 3750, 5000, 6250, 7500, 8750, 10000, 11250,' 12500, 
13750, 15000, 16250, 17500, 18750, 20000, 21250, 22500, 23750, 25000, 26250, 27500, 28750, 30000 
31250, 32500, 33750, 35000, 36250, 37500, 38750, 40000, 41250, 42500, 43750, 45000, 47500, 50000 
65000, 80000 meters. Default values of XX are used only if NXS is set to 0. 

The default values of the YY are the average layer wind direction i 180° rounded to the nearest 
5° added to each of the following angles: -40, -35, -30, -27, -24, -22, -20, -18, -16, -14, -12, 

-10, -8, -7, -6, -5, -5, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 18, 20, 22, 24, 27, 
30, 40 degrees. 

The limit values given for NDI, NCI and NTI mean there is a maximum of 10 possible isopleth 
values with a maximum of 3 critical pollutant levels (air quality standards) within the 10. The 
total number of values is input in the tens and hundreds positions and the number of critical 
pollutant levels is input in the units position. 

IZM(^D is a 3 digit integer where any one of the three digits can be an integer from 0 to 6 or the 
integer 9. See Section B.2 for a complete explanation of IZM0D. 

If these parameters are input, both bottom and top values are input respectively for each new 
layer in the layer step change. 

ZLIM is automatically calculated if IZM(^D contains a 5 (Model 5). 



B.4 


DATA INPUT FORMAT 


This Program uses the FORTRAN NAMELIST method to input data. Input 
data must be in a specific form in order to be read using a NAMELIST list. The 
first character in each card to be read must be blank. The first card in the NAME- 
LIST list contains the NAMELIST name NAM2 preceded by the character $ or &. 

The last card in the NAMELIST list contains $END (&END) to terminate the list. 

The form of the remaining data items in the list may be: 

a. Vca^ahte Name = Constant - The Dcccvdb'le name may be a subscripted 
array name or a single variable name. Subscripts must be integer constants. The 
constant may be int^er, real or Hollerith (nH at]p'hanionevio aharaoters) data. 

b. AftAny Marne = Set Com,tanti> (separated by commas) - The oAJiay 
name, is not subscripted. The 4et consiants consists of constants of the t3T5e integer 
or real. The number of constants must be less than or equal to the array size. 

Successive occurrences of the same constant can be represented in the form k* 
constant. 

The sequence of the input data parameters within the list is not signifi- 
cant. A more detailed explanation of the FORTRAN NAMELIST can be found in 
most FORTRAN language manuals. All Program input parameters are set to zero 
prior to input of the first case. Parameters that are not used or have default values 
need not appear in the input deck. When multiple cases are stacked, all parameters 
retain their values from the last case and are changed only by input. 
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B. 5 FORTRAN SOURCE LISTING FOR THE NASA/ MSEC MULTILAYER DIFFU- 
SION PROGRAM— VERSION 6 


This section contains the complete FORTRAN source listing of the NASA/ 
MSFC Multilayer Program — Version 6. 
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100 


♦* 

♦♦ 


I* 

z* 

z* 

4 * 

5 * 

6* 

7* 

8* 

9* 

10 * 

!!♦ 

12 * 

13* 

14* 

15* 

16* 

17* 

16* 

19* 

20 * 

21 * 

22 * 

23* 

24* 

25* 

26* 

27* 

28* 

29* 

30* 

31* 

32* 

33* 

34* 

35* 

36* 

37* 

38* 


*♦ NASa/MSFC MUUTII.AY£R diffusion program— version 6 


PK06RAM MOD£Uf VERSION 6, REVISION 0 


Q *****4(*******4i***4c**************************************************MDU00100 
c * NASA/MSFC MULTIUAYER DIFFUSION PROGRAM - VERSION 6 MDL00200 
c *****]|c*:tE*****4;***4t***4‘*************«********************************MDL00300 
C MDL00400 
C THIS version of THE NASA/MSFC MULTILAYER MODEL REQUIRES ThE USE MDL00500 
C OF mass storage logical unit 9 and 13, THE NUMBER OF TRACKS CAN MDL00600 
C BE THE system DEFAULT. ALSOr IF INUNT BELOW EQUALS 0 OR 10 OR IF MDL00700 
C NVHcLC below EQUALS 0 THE PROGRAM REQUIRES MASS STORAGE LOGICAL MDL00800 
C UNITS 10 and U AND TAPE OR MaSS STORAGE LOGICAL UNIT 12. THESE MDL00900 

c UNITS ARE The Same as those used by the preprocessor program, massmdloiooo 
C storage unit 10 requires at least 14 positions on the UNIVAC 1108 MDLOllOO 
C AND FILES 12 AND 11 CAN BE THE SYSTEM DEFAULT, MDL01200 
C MDL01300 
C MDL01400 
C THIS version of THE NaSA/MSFC MULTILAYER DIFFUSION MODEL MDL01500 
C IS designed to be used WITH OR WITHOUT THE MULTILAYER MDL01600 
C PREPROCESSOR MDL01700 
C MDLOieOO 
C data INPUT sequence MDL01900 
C MDL02000 
C *♦ DATA CARDl (READ FOR EACH PASS OF THE PROGRAM UNLESS THE LaST CASE MDL02100 
C .processed by THE PROg HAD THE VARIABLE MPS SET NON-2EROMDL02200 
C MDL02300 
C NVHCLC - integer REPRESENTING ThE VEHICLE TO BE PROCESSED MDL02400 
C 1= titan III C» 2= SPACE SHUTTLE^ 3= DELTA-THOR 291*^ MDL02500 
C 4= MINUTEMAN II » 5= DElTA-THOR 3914 (H FORMAT# COL 1) MDL02600 
C »$$ NOTE - IF NVHClC IS INPUT AS ZERO THE PROGRAM ASSUMES MDL02700 
C that multiple cases have been stacked ON MASS MDL02800 
C storage unit 10 and tape OR MASS STORAGE UNIT 12 MDL02900 
C BY ThE preprocessor. THIS PROGRAM WILL EXECUTE ALL MDL03000 
C OF THESE cases SEQUENTIALLY AND AUTOMATICALLY MDL03100 
C without any ADDITIONAL INPUT, ALL VARIABLES ON MOL03200 
C THIS ONE INPUT CARD MUST BE ZERO, I.E, INPUT ONLY MDL03300 
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i9* 

40* 

41* 

42* 

43 * 

44* 

45* 

46* 

47* 

46* 

49* 

50* 

bX* 

b2* 

b3* 

b4* 

bS* 

b6* 

b7* 

bS* 

b9* 

bO* 

61 * 

62 * 

63* 

64* 

65* 

66 * 

67* 

68 * 

69* 

70* 

7X* 

72* 

73* 

74* 

75* 

76* 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


ONE BLANK CARD. MDL03400 

METdTC 3 INTEGER V»ORD ARRAY FOR THE DATE OF THE MET DATa MDL03500 

MOuYYR (3j2 format » COuS 2-7) MDL03600 

NSNqC - sounding hour (00-24) (I2 FORMAT » COL 8-9) MOL03700 

NMOlDC - model number (13 FORMAT. COL 10-12) MDL03800 

REMEMBER TO INPUT THIS NUMBER EXACTLY LIKE THE MDL03900 

preprocessor prints IT IF USING PREPROCESSOR INPUT MDL04000 

DATA FROM MASS STORAGE. MDL04100 

NPLnTC - NUMBER REPRESENTING TH£ POLLUTANT. IsHcL. 2=C0» MOL04200 

3=C02. 4=aU203 (U FORMAT. COL 13) MDL04300 


INUnT - DATA UNPUT UNIT NUMBER. IF INUNT IS 0 THE PROGRAM SETS IT MDL04400 
TO 10 AND ASSUMES THE CASE IDENTIFIED BY THIS CARD DATA MDL04500 

IS TO BE FOUND ON MASS STORAGE UNIT 10 aNO TAPE OR MASS MDL04600 

STORAGE unit 12. THE PROGRAM THEN READS THIS DATA AND ALSOMDL04700 
reads namelist NAM2 FROM THE CARD READER FOR ANY UPDATES MDL04800 
OR modifications TO THE CASE. IF INUNT iS 5 THE PROGRAM MDL0490Q 

reads all remaining data THROUGH NAMELIST NAM2 VIA THE MDL05000 

CARD READER. (12 FORMAT . COL 79-80) MDL05100 

MDL05200 
MDL 05300 

namelist NAM2 INCLUDES THE VARIABLES - TESTNO. ISKlP.NXS.NyS.NZS. MDL05400 

ndi.nci.npts.nti.ti.nvs.nvb.xx.yy,2.delx.dely,q,ubark»sigak.sigek.molo550o 

SIGXO.SlGYOfGAMMAP.SlGZO. ALPHA. BETA. ZRK.TIMAV.THETAK.TAUK.TAUOK. MOL05600 

H . XRY . XRZ » XlRY . XLRZ » ZZL . IZMOD . DECAY . T iMl . BLAMDA . 01 . C I . TAST » ZLIM » MOL05700 

HB . PERCB . VB . VS » PERC » ACCUR , ALPHL » BETL . TAUL . TAUOL » ZRL » UBARL , SIGAL . MOL05800 


SIGEL . THETAL . NPS f NAMCAS . SCL » XMAX IN . YMAX IN . ISW , XMAXJN . YMAX JN . MDL05900 

RASTIN.XSIZe.YSIZE.XCIZE.YcIZE.TEMPK.TEMPL.JSW.NVHCL.METOaT.NSND. MDL06000 
NMOOL.NPLNT (SOME oF THESE VARIABLES ARE AUTOMATICALLY SET BY THE MOL06100 
program, consult THE DOCUMENTATION BEFORE PROGRAM USE) MOL06200 

MDL06300 

SEE SUBROUTINE TAPEIN AND READER FOR INPUT DATA CODING MOL06400 

MOL06500 

IMPORTANT program VARIABLES MDL06600 

MDL06700 

MDL06800 

MDL06900 

ISKiPs PROGRAM CONTROL OPTIONS MDL07000 

H = CLOUD STABILIZATION HEIGHT (METERS) MDL07100 


77* 
78* 
79* 
80* 
81* 
82* 
83* 
84* 
85* 
86 * 
87* 
88 * 
89* 
90* 
91 * 
92* 
M 93* 
g 94* 
95* 
96* 
97* 
98* 
99* 
100 * 
101 * 
102 * 
103* 
104* 
105* 
106* 
107* 
108* 
109* 
110 * 
111 * 
112 * 
113* 
114* 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


MQL07200 
MDL07300 
MDL07400 

LATtRAt POWER LAW EXPANSION COEFFICIENT MDL07500 
VERTICAL POWER LAW EXPANSION C0EFFICIEN7 MOL07600 
standard deviation OF The lateral source DINENSION (METER) MDL07700 


Z = boundary HLIGHTS OF LAYERS (METERS) 
Q = SOURCE strength IN LAYER 
UBAR = calculated TRANSPORT SPEED IN LAYER 
Alpha 
BETa 
SIGYO 
SIGAP 
SIGXO 


CALCULATED LATERAL DIFFUSION COEFFICIENT IN LAYER MDL07800 

STANDARD DEVIATION OF ThE ALONG WIND SOURCE DIMENSION MDL07900 

(METERS) MDL08000 

DELTHP = calculated WIND DIRECTION SHEAR IN'LAYeR MDL08100 

siGzo = standard deviation of the vertical Source dimension mdloszoo 

(METERS) MDL08300 

SIGEP = CALCULATED VERTICAL DIFFUSION COEFFICIENT MDL08400 

DELX = range TO SOuHCE IN LAYER RELATIVE TO ORIqIN OF REFERENCE MDL08500 
GRID SYSTEM (METERS) MDL06600 

DELY = AZIMUTH bEARiNG FROM 0 DEGREES NORTH TO SOURCE IN LAYER MDL08700 
(DEGREES) MDL08800 

THETA = calculated MEAN WIND DIRECTION IN LAYER MDL08900 

UMOD = MODEL OR MODELS To USE IN LAYER MDL09000 

DELU = CALCULATED WIND SPEED SHEAR MDL09100 

ZZL = CALCULATION HEIGHTS IN LAYER MDL09200 

DOS = CALCULATED VALUE OF DOSaGE MDL09300 

CON = CALCULATED VALUE OF CONCENTRATION MDL09400 

PEAKD = PART OF DOSAGE EQUATION MDL09500 

XX = range to calculation POINT OF THE POLAR COORDINATE REFERENCE MDL09600 
grid system (METERS) MDL09700 

YY = azimuth DEaRING from 0 degrees north TO CALCULATION POINT OF MDL09800 
THE polar coordinate REFERENCE GRID MDL09900 

LAT = lateral term OF DOSAGE EQUATION MDLlOOOO 

VER s vertical term OF DOSAGE EQUATION MDLlOlOO 

VrEF = reflection term OF DOSAGE EQUATION MDL10200 

T = SOURCE emission TIME IN LAYER FOR GRAVITATIONAL DEPt (SEOMDL10300 

TESTNO = meteorological CASE INFORMATION MDL10400 

DI = dosage ISOPLeIH values of interest MDL10500 

Cl = concentration isopleth Values of interest moliogoo 

TI 5 time mean concentration VALUES OF INTEREST FOR ISOPLeTHS MDL10700 
Siez = calculated standard deviation of the vertical dosage MDL10800 

distribution MDL10900 


oooooooo oooo nooooo ooooooooooooooooo o 


Sibr = calculated standard deviation of the: lateral dosage mdluooo 


DlSThlbiUTION 

siex = calculated standard deviation of the along wind dosage 
distribution 

Sorer = square root two pi 

L = length of cloud in along wind direction 

I = index of X coordinates 

0 = INDEX OF Y coordinates 

Kn = index of layers 

K = INDEX Over calculation heights zzl 

STOl = temp storage 

STOE = temp storage 

syo3 = temp storage 

TAST = time of layer STRUCTURE CHANGE (SECONDS) 

NdK = NO OF distinct GROUPS OF LAYERS THAT FORM INTO ONE aT TIME 
TAST, 

IcK = INDEX ON NEa LaYERS AFTER TIME TAST 

NXS = NO OF A coordinates 

NYS = NO Of y coordinates 

NZS = NO OF LAYER BOUNDARIES 

NUI = NO OF DOSAGE ISOPLETHS 

NCI = NO OF concentration ISOPLETHS 

NTI = NO OF TiMt MEAN CONCENTRATION ISOPLETHS 

npts = NO OF calculation heights zzl 

RAD = PI/180 

NNZ = NZS-i NO OF LAYERS 


MDLIUOO 

MDL11200 

MDLU300 

MDL11400 

MDL11500 

MDL11600 

MDL11700 

MDL11800 

MOL11900 

MDL12000 

MDL12100 

MDU12200 

MDL12300 

MDL12400 

MOL12500 

MDL12600 

MQL12700 

MDL12800 

MOL12900 

MDL13000 

MOL13100 

MDL13200 

MDL13300 

MDL13400 

MDL13500 


nop = TOP OF NEW LAYER AFTER TAST IN TERMS OF OLD LAYER STRUCTURMDL13600 
IbO] = bottom of new LAYER AFT£R TAST IN TERMS Op OLD LAYER MDL13700 

structure (I top and IBOT INDEXES) MDL13800 


XAST = calculate DISTANCE TO TaST MDL13900 

SIGXNK = SIGX OF NEW LAYER STRUCTURE MDL14000 


8LAiviDA=LAMBuA= wAShOUT COEFFICIENT MDL14100 

TIMI = TIME OF start OF RAIN (SECONDS) MDL14200 

ZLiM = MAXIMUM HtlGHT OF WASHOuT MDL14300 

w’AShOU = calculate washout at GROUND MDL14400 

UBArK = WIND SPEEL/ at EACH LAYER BOUNDARY^ LOWER BOUNDARY OF LAYERMDL14500 
1 FOR UbARK IS ASSUMED aT ZRK (METERS/SEC) MDL14600 


SIGaK = SIGaP (INITIAL) AT EACH LaYER BOUNDARY » LOWER BOUNDARY OF MDL14700 
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Ab7* 

Iba* 

ib9* 

i70* 

i7X* 

172* 

X73* 

174 ^ 

i75* 

i76* 

177* 

i78# 

X79* 

lao* 

ibl» 

iB2* 

ib3* 



C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


Layer i for sigak is assumed at zrk (degrees) mdli480o 

SiGcK = SIGEP (INITIAL) AT EACH LAYER BOUNDARY » LOWER BOUNDARY OF MOL14900 


layer 1 FOR SiGEK IS ASSUMED AT ZRK (DEGREES) 
ZRK = REFERENCE HEIGHT IN SURFACE LAYER (METERS) 
ThETAK = wind DIRECTION AT LAYER BOUNDARIES (DEGREES) 


MOL15000 

MDL15100 

MDLX5200 

MDLX5300 

MDLX5400 

MDLX5500 


TAUk = time in seconds required FOR lateral cloud STABILIZATION MDLX5300 

TaUoK = SAMPUING period IN SECONDS AT THE TOP OF THE LAYER MDLX5400 

decay = decay COEFFICIENT IN DOSAGE EQUATION MDLX5500 

UBARL = WIND SPEED AT BOTTOM ANd TOP OF EACH NEW LAYER AFTER LAYERMOLX5600 

CHANGE (METERS/SEC) MDLX5700 

SIGAL = SIGaP at bottom AND TOP OF EACH NEW LAYER AFTER LAYER MDLX5800 
CHANGE (DEOREES) M0LX5900 

SlGcL = SIGeP AT BOTTOM AND TOP OF EACH NEW LAYER AFTER LAYER MDLXbOOO 
change (DEGREES) MDLX6X00 

ZRL = reference HEIGHT IN SURFACE LAYER OF NEW STRUCTURE (METERS) MDLX6200 

ThETAL = wind DIRECTION AT BOTTOM AND TOP OF EACH NEW LAYER AFTER MpLXbSOO 


TAUe = 

TAUOL - 
JbOT = 

j) op = 

VS = 

perc = 
ACCUR = 


VB 

PLRCB 

HB 

PPWR 

QPWR 

MPWR 

DIHk 

NVS 


time in seconds for lateral CLOUD STABILIZATION IN NEW MDLX6400 
layer structure MDLX6500 
time in SECONDS OF SAMPLING PERIOD AT ToP OF NEW LAYER MDLXbbOO 
INPUT layer number OF BOTTOM OF NEW LaYeR STRUCTURE MOLX6700 
relative to old MDLX6800 
INPUT LAYER NUMBER OF ToP OF NEW LAYER STRUCTURE MDL16900 
relative TO OLD MDLX7000 
settling velocity in gravitational DEPOSITION model MDLX7X00 
FREQUENCY OF VS MDLX7200 
desired accuracy coefficient (*45) INSURES THAT GROUND MDLX730Q 
DEPOSITION FROM NXCl POiNT SOURCES IN THE LAYER VARIES MDLX7400 
LESb than ten percent FROM DEPOSITION EXPECTED FROM A MDLX7500 
VERTICAL LINE SOURCE IN THE LAYER. FOR (.32) REDUCED TO MDLX7600 
FIVE PERCENT MDLX7700 
SETTLING velocities FROM A BURST OR DESTRUCT IN LaYER NNZ MDLX7800 
FREQUEI4CY oF Vb MDLX7900 
HEIGHT OF BURST (METERS) MDLX8000 
CALCULATED WIND SPEED POWER L/\W EXPONENT MDLXSXOO 
CALCULATED SIGEP POWER LAW EXPONENT MDLX8200 
calculated SIGAP POWER LAW EXPONENT MDLX8300 
wind angle shear MDLX8400 
NUMBER OF settling VELOCITIES VS MDLX8500 
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ivi* 

192* 

194* 

i95* 

i96» 

i97* 

iV8* 

A99* 

2 U0* 

aox* 

2024c 

2034C 

2U4« 

2054c 

206 * 

207* 

208* 

209* 

2 lO* 

211 * 

212 * 

213* 

214* 

215* 

216* 

217* 

218* 

219* 

220 * 

221 * 

222 * 

223* 

224* 

225* 

226* 

227* 

226* 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


NVB = number of settling velocities vb 
II = INDEX ON vs and Vb 

DEP = temp storage 

ybary = calculated corrdinate of point on cloud axis of vs at 
intersection with ground (DEPOSITION) 

XBARX 5 CALCULATED CORRDINATE Op POINT ON CLOUD AXIS OF VS AT 
intersection with ground (DEPOSITION) 

UbARNK = calculated WIND SPEED (DEPOSITION) 

BETaNK = calculated beta (DEPOSITION) 

AlPhNK = calculated alpha (DEPOSITION) 

SGBaR = temp STORAGE 

ANG = angle to POINT XBARX, YBARY (DEPOSITION) 

NXCX = number of POINT SOURCES IN LAYER (DEPOSITION) 

OEPn = calculated VALUE OF GRAVITATIONAL DEPOSITION 

SIGYNK = SIgY of new layer structure in calculation of DOSAGE and 
concentration 

SIGlNK = calculated SIGEP (DEPOSITION) 

SIGaNK = calculated SIGAP (DEPOSITION) 

TIMaV = concentration averaging time (SECONDS) 

AVCON S AVERAGE CONCENTRATION 
PASsTM = time OF CLOUD PASSAGE 
AVMXCN s MAXIMUM AVERAGE CONCENTRATION 

XRY = DISTANCE DOWNWIND FROM THE VIRTUAL POINT SOURCE OVER 

WHICH RECTILINEAR EXPANSION OCCURS LATERALLY (METERS) 
XRZ = DISTANCE DOWNWIND FROM THE VIRTUAL POINT SOURCE OVER 

WHICH RECTILINEAR EXPANSION OCCURS VERTICALLY (METERS) 
XLRY = DISTANCE FROM TRUE SOURCE TO POINT OF MEASUREMENT OF 
SI6Y0 (METERS) 

XLRZ 5 DISTANCE FROM TRUE SOURCE TO POINT OF MEASUREMENT OF 
SIGZO (METERS) 

gamma = FRACTION OF MATERIAL REFLECTED AT THE SURFACE (si FOR 
complete reflection# so FOR NO REFLECTION) 

GAMmAP s 1,0-GAMMA 

namcas = SPECIAL Case identification information 
scL - MAP Scale factor in inches for isopleth plots, if the map 
scale factor is 1 Inch = 24000 inches then scl would be 
input as 24000, (IF 0 THE PROGRAM WILL CALCULATE SCL) 

ISW » SWITCH FOR maximum CENTERlINE PLOTS, IF SET TO 0 OR 2 


MQLie600 

MDL18700 

MOL18800 

MDL18900 

MQL19000 

MDL19100 

MDL19200 

MDL19300 

MDL19400 

MDL19500 

MOL19600 

MDL19700 

MOL19800 

MDL19900 

MDL20000 

MDL20100 

MOL20200 

MDL20300 

MDL20400 

MOL2Q500 

MDL20600 

MDL20700 

MDL20800 

MDL20900 

MDL21000 

MDL21100 

MDL21200 

MDL21300 

MDL21400 

MOL21500 

MPL21600 

MDL21700 

MOL21800 

MDL21900 

MDL22000 

MDL22100 

MDL22200 

MDL22300 


ooooooooo 


LOG-LOG SCALING IS USED. IF SET TO I LINEAR IS USED. MOL22400 

XMAXUN - MAXIMUM ALONOWIND DISTANCE FROM THE LAUNCH SITE FOR MDL22500 

MAXIMUM centerline PLOTS (METERS) (IF 0 PROG CALCULATES) MQL22600 
XMAxIN - MAXIMUM AlONOWIND DISTANCE FROM THE LAUNCH SITE FOR MDL22700 

ISOPLETHS (METERS) (IF 0 PROGRAM CALCULATES) MDL22800. 

YMAXIN - MAXIMUM CROSSWIND DISTANCE FOR ISOPLETHS (METERS) (IF 0 MDL22900 

PROGRAM CALCULATES) MDL23000 

YMAXJN - MAXIMUM NUMBER OF LOG CYCLES FOR THE VERTICAL AXiS OF MDL23100 
the maximum centerline plots if ISV. = g OR 2, OR, MAXIMUMMUL23200 
value of the VERTICAL AXIS IF ISW =1, (IF 0 PROGRAM MOL23300 
CALCULATES) MDL23400 

TEMpK - virtual POTENTIAL TEMPERATURE AT EACH LAYER BOUNDARY. THISMDL23500 
array is used TO SEE IF THERE IS A NEGATIVE LAPSE RATE MDL23600 
IN THE layer, the prog CHECKS TO SEE IF THE WIND SPEED MDL23700 
shear is negative, if IT IS AND ALSO THE LAPSE RATE IS MDL23800 
negative the program uses the absolute VALUE OF The SPEED MDL23900 
shear . IF The speed shear is negative ANU the LAPSE rate MDL24000 
IS POSITIVE OR TEMPK IS NOT INPUT THE PROGRAM USES 0 WIND MDL24100 
SPEED SHEAR. MDL24200 

TEMPL - virtual potential temperature at each layer boundary of MDL24300 

The new layer structure, MDL24400 

HAST IN = THt NUMBER OF RASTER COUNTS PER INCH ON THE SC4020 FOR MDL24500 

ISoPLETH and maximum CENTER LINE PLOTS, MDL24600 

XSIZE = The number of raster counts on the SC4020 in the X OR MDL24700 
horizontal plot AXIS (EAST-WEST). FOR ISOPLETHS MDL24800 

YSIZE S The number of raster counts on the SCAOZO in the Y or MDL24900 

VERTICAL (NORTH-SOUTH) PLOT AXIS FOR ISOPlETHS MDL25000 

XCIZE = The number of raster COUNTS ON THE SC4020 IN THE X OR MDL25100 

ALONGwIND horizontal AXIS FOR MAXIMUM CENTERLINE PLOTS, MDL25200 
YCUE = The number of raster counts on the SC4020 IN THE VERTICAL MDL25300 
AXIS FOR MAXIMUM CENTERLINE PLOTS MDL25400 

NVHCL = Same mS NVHCLC MDL25500 

MeTuAT = same as METDTC MDL25600 

NSND = same as NSNUC MDL25700 

nmodl = Same as nmodlc mdl25800 

NPLNT 5 same as NPLNTC MDL25900 

MDL26000 

MDL26100 


xsue = 

YSIZE s 
XCIZE = 
YCUE = 
NVHCL = 




C 


MDL26200 

abB* 

C 


MDL26300 

£69<«c 

C 


MDL26400 

i.70* 

C 


MDL26500 

km* 


COMMON /PaRaMT/ TESTN0a2), ISKIP ( 15) rNXS»NYS»NZS»NDI »NCI » 

MDL26600 

kik* 


lNbK,NPTS»NVS»NV&,XX(41),YY(4l)»2U6)»DELX{15),DELY(15),Q(l5), 

MDL26700 

ZIZ* 


2UBARK(16) »SIGaK( 16) fSieEK(l6) »SlGX0(15) »SIGY0(15) »SI620(15) » 

MDL26800 

klk* 


3AUPhA( 20) fB£TA(20) » 2RKrTlMAV»THETAK (16) ,TAUK»TAUOK» Hf XRY»XRZ» 

MDL26900 

km* 


4XURy»XI:RZ» 22L(40) »lZMODa5)»DECAY,ZHM,nMlrLAMbDA»DI(10)»CI(10) » 

MDL27000 

k7b* 


5TAST(05) »JBOT(05) »jTOP(05) ,VS(20) »PERC(20) »ACCUR»VB(20) »P£RCB(20) 

»MDL27100 

k7i* 


6HB»ALPHL(05) »BETL(05) fTAUL»TAUOl»ZRL»UBARL(10) »SI6AL(10) »SI6EL(10)MDL27200 

k76* 


7rTH£TAL(lO) rGAMMAP(20) »NTl,TI (10) rNPS»NAMCAS(12) 

MDL27300 

k79* 


common /PARAMS/ UBAR(£0) »S16AP(20) rDELTHP(20) »SlG£P(20) »THETA(20) 

»MDL27400 

2B0* 


XOEUU(20) »VER,VREFfPeAKD»SlGZ»SlGY,SI6XfSQR2P»L»THrI»J,KK»ST01f 

MDL27500 

kbx* 


2ST 02 » ST03 » TRD » ILK » RAD » NNZ r ITOP » IBOT » XAST ( 21 ) » SIgXNK » JP t PPWR » QPWR f 

MDL27600 

ktik* 


3MPWR,I1»D£P,XBARX»SOBAR»NXCI»LAT»SI6YNK»6AMMA(20) »ncc»ndd,ntt» 

MDL27700 

^ kbZ* 


4NCCC » NDDD » NTTT » NSV* 2 » MODES (15 ) » KSW ( 5 ) » L I NES » IMl » MDLS » NWD » 

MDL27800 

° 2b4* 


5YSV(41) ,YBARY(41) fUBARNK(4l) fBETANK(41) » ALPHNK (41) »ANG(42 ) t 

MDL27900 

kbB* 


6SIG£NK(41) »SI6ANK(4l) »DEPN(41»41) ,RN6fAZM»IDATE(2) »ITIME(2)»YT» 

MDL28000 

kbb* 


7NYSS»CDAMX(3) 

MDL28100 

267* 


DIMENSION CON(l) »DOS(l) »AVC0N(1) »PASSTM(1) 

MDL28200 

ktiB* 


dimension NUNM(12) »0TNM(2) 

MDL28300 

kB9* 


equivalence (C0(m,DEPN) » (D0S»DEPN(1»2) ) » (AVC0NfDEPN(l»3) ) » (PASSTM» 

DMDL28400 

k^Q* 


1EPN(1,4)) 

MDL28500 

k9i* 


real mpwr»l,lat, lambda 

MDL28600 

k9k* 


Integer testno 

MDL28700 

k'iz* 


data DTNM/6hPRECIP» 0H GRAV/»NUNM/6H(M6/M*»3H*2) »6H (PH)rlH »6H (MMDL28800 

294* 


1G/M*»3H*3) »6H(MGS£C»6H/M**3) »6H (PPM,1H)»6H (PPM»5H SEC)/»NPLNTPMDL28900 

295* 


2/6HAL203 / 

MDL29000 

296* 


data ZEROES/0.0/ 

MDL29100 

297* 

C 

♦♦* INPUT SECTION *** 

MDL29200 

298* 


SQR2P = 2*5066263 

MDL29300 

299* 


RAD = .01745329 

MDL29400 

500* 


IFF s 1 

MDL29500 

501* 


MBR s 0 

MDL29600 

502* 

C 

READ MODEL parameters 

MDL29700 

503* 


1 CALL READER (IFF) 

MDL29800 

504* 


IFF s 2 

MDL29900 
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dU5« 

IF (KSW(l) 0) 60 TO 5 


MDL30000 


C EXECUTE GRAVITATIONAL DEPOSITION MODEL 

MDL30100 

^07* 

CALL DEPOS 


MDL30200 


GO TO 700 


MDL30300 

509« 

5 continue 


MDL30400 

.^10« 

IF (ISKIP(2) ,LE. 1«AND.ISKIP(3) .LE. 1) 60 TO 6 


MDL30500 

311* 

IF (MBR #£0. 5) 60 TO 6 


MDL30600 

312* 

MttR = 5 


MDL30700 

313* 

call IDENT(35f ’hard C0PY» 1 EACH» PLUS FILM*) 


MOL30600 

314* 

CALu SETMiV(0»0,0»0) 


MDL30900 

315* 

6 CONTINUE 


MOL31000 

316* 

DO a I=l»3 


MDL31100 

317* 

8 CDAMX(I) = 0«0 


MOL31200 

318* 

IF (ISKIP(5) ,EQ. 1.AND*ISKIP(9) ,EQ. 1) CDAMX(l) = 

14.0 

MDL31300 

319* 

ILK = 1 


MDL31400 

320* 

DO 10 Jsl»4l 


MDL31500 

321* 

DO 10 I=l»4l 


MDL31600 

322* 

10 D£PN(I»J) = 0.0 


MOL31700 

323* 

20 CONTINUE 


MOL31800 

324* 

KTK = 1 


MDL31900 

325* 

K = 1 


MDL32000 

326* 

NYSS = NYS 


MOL32100 

327* 

IMB s 0 


MDL32200 

328* 

IF6 s 0 


MDL32300 

329* 

DO 500 KK5l,NN2 


MDL32400 

330* 

C *** list INPUT parameters *♦* 


MOL32500 

331* 

write (6»903) KK 


MOL32600 

332* 

write (6»904) 


MDL32700 

333* 

IF (KK ,NE. 1) 60 TO 92 


MOL32800 

334* 

WRITE (6»905) Q(KK) *2RK»UbaRK(Kk) »UBARK(KK+1) »Si6aK(KK) »S l6AK(KK+lMOL32900 

335* 

1) »SIGEK(KK) »SI6EK(KK+1) »TAUK»TAu0K»SI6X0(KK) »SI6Y0(KK) ,SI6Z0(KK) » 

MDL33000 

336* 

2THETAK(KK) »THETaK(KK+1) »Z(KK)»AlPHA(KK) iBETA(KK) 

DELX(KK)» 

MDL33100 

337* 

3DELY ( KK ) » IZMOD ( KK ) » T IMI » ZL IM » LAMBDA » TIMAV » XR Y » XRZ » XLRY » XLRZ 

MOL33200 

336* 

4»6AMMAP(1) 


MDL33300 

339* 

60 TO 93 


MOL33400 

340* 

92 continue 


MDL33500 

341* 

write (6»918) Q(KK) »UBARK(kK) »UbARK(KK+1) »SI6AK(KK> 

»SI6AK(KK+1) » 

MDL33600 

342* 

1SI6EK(KK) »Si6EK(KK+l) »SI6X0(KK) »SI6Y0(KK) rSI6Z0(KK) 

»THETAK(KK)f 

MDL33700 
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^43* 

344* 

345* 

346* 

347* 

348* 

349 * 

330i(> 

3bl+ 

352« 

3b34t 

3b4« 

3b5« 

3b6« 

3b7» 

3b8« 

3b9* 

3b0« 

3bl* 

3b2« 

3b3* 

364* 

365* 

366* 

367* 

368* 

369* 

370* 

371* 

372* 

373* 

374* 

375* 

376* 

377* 

378* 

379* 

360* 


93 


94 


2ThETAK(KK+X) ,2 (KK) ,ALPHA(KK) »BEtA(KK) »DELX(KK) »DELY(KK) » 
31^MOD(KK} 

IP (KK .N£. NNZ) go to 94 
WRITE (6»919) Z(KK+D 
CONTINUE 

NNZILK = NNZ+ILK 

IF (NBK .EQ, O.OR.KK ,NE. JBOT(ILK)) 60 TO 97 
IF (JBQT(ILK) ,NE. D GO TO 96 
LSP = ILK+2-1 


MDL33800 

MDL33900 

MDL34000 

MDL34100 

MDL34200 

MDL34300 

MDL34400 

MDL34500 

MDL34600 


write (6»920) ZRL»UBARL(LSP) »UBaRL (LSP+1) »SIGAL(LSP) »SI6AL(LSP+1) »MDL34700 
XSIGEL(USP) »SI6EL(LSP+X) »TheTAL(LSP) »ThETAL (LSP+ l) rTAUL»TAUOL» MDL34800 
2 ALPHA ( NNZILr ) , BETA ( NNZILK ) , TAST ( ILK ) » JBOT ( ILK ) » jTOP ( ILK ) MDL34900 

60 TO 97 MDL35000 

96 CONTINUE MOL35XOO 

LSP = ILK*2-X MDL35200 

write (6»92X) UBARL(LSP)»UBARL(LSP+X) »SIGAL(LSP)»SI6AL(LSP+X)» MDL35300 
XSIGeL(LSP) fSl6 £L(LSP+X) »ThETAL(LSP) f T hETAL(LSP+X) rTAULrTAUOL» ALPHAMDL35400 


2(NNZILK) rBETA(NNZILK) »TAST(ILK) ,JbOT(ILK) rUTOPULK) 

97 CONTINUE 

WRITE (6»922) UBAR(KK) »TH£TA(KK) rOELTHP(KK) »DELU(KK) rSIGAP(KK) , 
XSIGEP(KK) 

IF (NBK tEQ. O.OR.KK.NE. JBOT(ILK)) GO TO 98 

WRITE (6»923) UbAR(NNZlLK) ,THET a(NNZILK) »DELTHP(NNZILK) » 

XDELU (NNZILK ) » SIGAP ( NNZILK ) , SIGEP (NNZILK ) 

98 CONTINUE 

CALL TESTR(KTK) 

WRITE (6r9X7) 

GENERAL GRID PATTERN CALCULATIONS ♦*♦ 


X40 


0) 

GO 


GO 

TO 


TO X45 
500 


145 


148 


*** 

CONTINUE 
OF = NNZ+ILK-X 
IF (KSW(2) .LE. 

IF (IFG .EQ, X) 

GO TO X48 
CONTINUE 

IF (K ,6T. NPTS) 60 
IF (ZZL(K)-Z(KK+X)) 

MDLS = MODLS(KK) 

IF (NBK.6T,O.AND.KK.6£.IBOT,AND.KK,LE,ITOP) MDLS = 4 


TO 500 
X46. 500.500 


MDL35500 

MDL35600 

MDL35700 

MDL35800 

MOL35900 

MOL36000 

MDL36100 

MDL36200 

MOL36300 

MDL36400 

MDL36500 

MDL36600 

MDL36700 

MOL36800 

MDL36900 

MDL37000 

MDL37100 

MPL37200 

MDL37300 

MDL37400 

MDL37500 
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obi» 


IF (NBK .UE, 0) 60 TO 149 

MDL37600 



IF (KK ,LT. IBOT.OR.Kk ,67. ITOP) 60 TO 149 

MUL37700 



YT = theta (sJF) +180,0 

MDL37800 

ian* 


ZBSL = Z(IBOT) 

MDL37900 

4B5* 


ZIPl = ZtlTOP+1) 

MDL38000 



60 TO 150 

MDL38100 

3B7* 

149 

YT = THETA(KK)+180.0 

N1DL38200 

iHQ* 


ZbSL = Z(KK) 

MQL38300 



ZTPl = Z(KK+1) 

MDL38400 

390* 

150 

continue 

MDL38500 

391* 

C 

default YY (ANGULAR AXES) 

MDL38600 

392* 


IF (IMB .£0, 1) GO TO 153 

MDL38700 

393* 


IF (NYS ,6T, 0) GO TO 153 

MDL38800 

394* 


OEP = YT 

MDL38900 

395* 


NYSS = 41 

MUL39000 

396* 


DO 152 J=1»NYSS 

MDL39100 

397* 

152 

YY(j) = DEP+YSV(J) 

MDL39200 

398* 

153 

CONTINUE 

MDL39300 

399* 


DO 200 I=1»NXS 

MDL39400 

400* 


DO 160 J=1»NYSS 

MDL39500 

401* 


If (KSW(2) ,GT, 0) GO TO 155 

MDL39600 

402* 


CALu BR£AK(K»XX(I),YY(0)) 

MDL39700 

403* 


CUAMX(l) = AMAXKCDAMX(I) »CON(U) ) 

MDL39800 

404* 


C0AmX(2) = AMAX1(C0AMX(2) ,OOS(J) ) 

MDL39900 

405* 


CuAmX(3) = AMAX1(C0AMX(3) »AVCON(J) ) 

MDL40000 

406* 


GO TO 160 

MDL40100 

407* 

155 

CALL WASHT 

MDL40200 

408* 

160 

CONTINUE 

MDL40300 

409* 


IF (KSW(2) ,L£. 0) GO TO 170 

MDL40400 

410* 


IMB = 1 

MDL40500 

4ll« 


60 TO 200 

MDL40600 

412* 

170 

CONTINUE 

MDL40700 

413* 

C 

OUTPUT GENERAL 6RID PATTERN CALCULATIONS 

MDL40800 

414* 


KOUT = 4*1-3 

MPL40900 

415* 


Call intout ( con » kout » n yss » 2 » i » i ) 

MDL41000 

416* 


KOUT = 4*1-2 

MDL41100 

417* 


CALL 1 NTOUT (DOS » KOUT » N YSS , 2 , 1 » 1 ) 

MDL41200 

418* 


KOUT = 4*1-1 

MDL41300 
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419* 

421 * 

422* 

•♦23* 

424* 

425* 

426* 

427* 

426* 

429* 

430 * 

431* 

432* 

433* 

434* 

435* 

436* 

437* 

436* 

439* 

440* 

441* 

442* 

443* 

444* 

445* 

446* 

447* 

446* 

449* 

4b0* 

4bl* 

4b2* 

4b3* 

4b4* 

4b5* 

4b6* 


CALL lNT0UT(AVC0N»K0UT»NYSS»2rl,l) 
KUUT = 4*1 

Call IiMT0UT(PASSTM,K0UT,NYSS»2,l»l) 
200 continue 

IF (KS^J(2) ,LL. 0) 60 TO 210 
IF (2(KK+i) .LT, ZLIM) 60 TO bOO 
IF6 = 1 

C OUTPUT WASHOUT QEPObITION PATTERNS 

DO 205 J=i»NYbS 

DO 205 I=1»NXS 

IF (ISKIP(5) 

IF (DEPNdfU) 

IF (DEPNUfJ) 

IF (DEPN(Iru) 

DEPis(lfJ) = 

IF (OEPN(ifu) ,LE 
CDAmX(I) = AFUNKCDAMXd) ,DEPN(I»j) ) 
GO TO 205 

204 CLAMXtl) = AMAXKCDAMXd) ,OEPN(I»J) ) 

205 CONTINUE 
MDLS = 5 
Z4Ld) = ^d) 

call GENPKT(1,ZdSL»ZTPU 
Go TO' 500 

210 continue 

CALL GENPRTtK»ZbSL»2TPL) 

K = K+1 

IF (K .GT, NPTS) go TO 500 
IF (ZZL(K} ,LT. Z(KK+D) go TO 146 

500 continue 

C **♦* LOOP FOR NEXT TtST ***** 

700 CONTINUE 

WHITE (9) (ZEH0tS»J=l»6) 

IF (NPS .EO, 0) GO TO 1 
777 continue 
800 CuNTINUE 

C RLAL and wRiTL OUT SUMMART INFO 

c 


MDL41400 

MDL41500 
MDL41600 
MDL41700 
MDL41800 
MDL41900 
MDL42000 
MDL42100 
MDL42200 
MDL42300 
MDL42400 
MDL42500 
MDL42600 
MDL42700 
MDL42800 
MDL42900 
MDL43000 
MDL43100 
MDL43200 
MDL43300 
MDL43400 
MDL43500 
MDL43600 
MDL43700 
MDL43800 
MDL43900 
MDL44000 
MDL44100 
MDL44200 
MDL44300 
MDL44400 
MOL44500 
MDL44600 
MDL44700 
MDL44800 
MDL44900 

FOR THIS RUN MDL45000 

MDL45100 


.GT. 1.0H.ISKIP(9) .EQ. 0) 60 TO 204 
.LE. 0.0) GO TO 205 
.GT. 1.0) DEPNdfJ) = 1,0 
.LT. l.UE-14) DEPNd»J) = l.OE-14 
-ALOG10(DLPN(I,J) ) 

0,0) DLPNdtj) z l.OE-20 
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4b7* 

4!58* 

4b9* 

HfaO* 

461 * 

4b3* 

464 * 

465* 

466* 

467* 

468* 

469* 

470* 

471 * 

472* 

4/3* 

474* 

475* 

478* 

4/7* 

478* 

479* 

480* 

481* 

482* 

484* 

485* 

486* 

487* 

488* 

489* 

490* 

491* 

492* 

493* 

494* 


LbTMOL = 0 
ENDFILE 9 
KEWIND 9 
I HUN = 1 

810 RtAQ (9,END=880) IVHCl » lVhC2» iVHC3»NMNTH»MDAY »MYEAR»MHR»NKODLr 

iiflnti 

read (9) SUMHfSUMRNGfSUMAZMfTlFiX 

read (9) (CDAMX(KJ »K=if3) »RT0F,X,AT0MX,ZT0MX»Z8SL»2TPL 
NWMdL - 1 

IF (CDAMX(3) ,6E, OfO) GO TO 850 
IF (CDAMX(3)+6,Q) 840r640,8l5 
8iS CONTINUE 
NwMDL = 5 

I = I 
J » 1 

IF (CDAMXU) ,UT, 0.0) U = 3 
820 IF (NWMDL ,EQ, LSTMDL) GO TO 830 

LSTmDL = nwmdu 

889 lines = 7 

white (6»92b) DTNMID iNUNM(J) »NUNM(J+1) ,DTNM(I) ,OTNM(I) 

830 lines = LINES+1 

IF (LINES .gT, 55) 80 TO 829 

WHITE ( 6 » 927 ) IKUN 1 1 VhCl 1 1 VHC2 . 1 VHC3 . MFNTH » MOAY » MYEAR t MHR » NMODL » 
1 IPLnTI r SUMH , RTOMX r aTONX . ZTOMX » ZbSL . ZTPL . CDAMX ( 1 ) 

831 READ (9) (CDAMX (K ) »K=1 , 3) . RTOMX , ATOMX .2T0MX .ZBSL »ZTPL 
YT = C0AMX(3)+RT0MX+AT0MX+ZT0mX+ZBSL+ZTPL 

IF tYT) 832,833,832 

832 LINES = LiNtS+1 

IP (LINES .GT, 55) GO TO 829 

WHITE (6»929) RTOMX » ATOMX ,ZT0MX , ZbSL r ZTPL r CDAMX ( I ) 

GO TO 831 

833 CONTINUE 
GO TO 870 

840 I 5 2 

NWMdL = 6 
0 = 1 
GO TO 820 

850 IF (NWMOL ,EO, LSTMDL) GO TO 86Q 


MDL45200 

MDL45300 

MOL45400 

MDL45500 

MDL45600 

MDL45700 

MDL45800 

MDL45900 

MDL46000 

MDL46100 

MDL46200 

MDL46300 

MDL46400 

MDL46500 

MDL46600 

MDL46700 

MDL46800 

MOL46900 

MDL47000 

MOL47100 

MDL47200 

MDL47300 

MDL47400 

MOL47500 

MDL47600 

MDL47700 

MDL47800 

MOL47900 

MDL48000 

MDL4B100 

MDL48200 

MOL48300 

MDL48400 

MDL48500 

MOL48600 

MDL48700 

MOL48800 

MDL48900 


LS»TmDL = NWmdL 
J = 9 
I = 11 

IF (IPLNTl ,N£, NPLNTP) GO TO 855 
d = 5 
I s 7 

855 CONTINUE 

TiMX = TIMX/60.0 
857 lines = 7 

WKITE (6f925) TIMX,NUNM(J) ,NUNM(JfX) »NUNM(I) rNUNMa+1) ,NUNM(d) t 
1NUNm(J+1) 

860 lines = LINES+1 

IF (LINES ,6T, 55) GO TO 657 

WRITE ( 6 » 928 ) IRUN r I VhC 1 » I VHC2 » I VhC3 » ^MNTH t MDAY , MYEAR » MHR r NMODL » 
1 IPLNTl t SUMH , RTOMX » aTONiX , ZTOMX , ZbSL r ZTPL » ( CDAMX ( K ) » K=1 » 3 ) 

861 REAt) (9) ( CDAMX (K ) ,K=1» 3) , RTOMX, ATOMX, ZTOMX »ZBSLf ZTPL 

YT = CDAMXU)+CDAMX(2)+CDAMX(3)+RT0MX+aT0MX+ZT0mX+ZBSL+ZTPL 
IF (YT) 862,863,862 

862 lines = HNeS+1 

IF (LINES ,GT, 52) GO TO 857 

WRITE (6»930) RTOMX»ATOMX,ZTOMX,ZBSL»ZTPL» (CDAMX(K) »K=1,3) 

GO TO 861 

863 CONTINUE 


MQL49000 

MDL49100 

MDL49200 

MDL49300 

MDL49400 

MDL49500 

MDL49600 

MOL49700 

MOL49800 

MOL49900 

MDL50000 

MDL50100 

MDL50200 

MDL50300 

MDL50400 

MDL50500 

MDL50600 

MDL50700 

MDL50800 

MDL50900 

MDL51000 

MOL51100 

MDL51200 


870 CONTINUE MDL51300 

IRUN = lRUN+1 MDL51400 

GO TO 810 MDL51500 

880 continue MDL51600 

IF (MBR *£0. 5) call ENDdOB MDL51700 

903 Format (1H0,55X,11h***** LaYER»I2,6H ♦♦♦♦♦) MDL51800 

904 format (lH0,57X,16h** INPUT DATA ♦♦) MDL51900 


905 format (4H0 Q=,E14.8,6H, ZRK=,F7.3, 17h, UBAR AT B0TT0M=»F8.4, 14H, MDL52000 
lUBAR at T0P=,F8.4,18H, SIGAK AT B0TT0M=,F8.5/14h SIGAK AT TOP=,F8.MDL52100 
25»l8H, SIGEK AT B0TT0M=,F8.5, 15 h, SIGEK AT T0P=,FS.5,7H» TAUK=,F8,MDL52200 
33, 8h, TAUOK=,F8.3/7h SI6X0=,F9.4»6H, SIGY0=,F9.4»8H, SIGZO=»F9.4,lMDL52300 
49H, ThETAK at B0TT0M=,F8.3,16H, THETAK aT T0P=,F8.3,4h, Z=»F9,3/7HMDL52400 
5 ALPHAS, F4.i»bH B£TA=, F4. 1 , 4H, H=,F9.3,7H, DELXs,£l4,8,7H, DELY=,£MDL52500 
614. 8, 8h, IZmODs,I3,7h, TIM1=,E14.8/6H ZLlMs,F9.3, MDL52600 

79H, lambdas, F7, 4, 8H» TIMAVs,F8.3,6H, XRYs,F8.3,6H, XRZs,F8.3,7H, XMDL52700 




8Uf<Ys»F8,3»7H» XLRZ=»F8.3»9H» GAMMaP=»F5,3) MDL52800 

534* 917 format ( 12X, 18 (6H— ’-—)/) MDL5290Q 

b35* 9ia format (4h 0 Q=»t.l4,6»17H» UBAR aT BOTTOMS^ F8.4»14h» UbaR AT TOP=r FMDL53000 

536* 18,4, 18H» SlGAK AT fa0TT0M=»F8,5» 15 h» SIGAK AT T0R=,F8.5/17h SIGEK AMDL53100 

537» 2T Bottoms rFb, 5 »15H» SiOEK aT T0p=,F8,5,8H» SIGX0=»F9,4»6H, SIGYO=»MDU53200 

038* 3F9,4,8h, SIg 20=,F9,4, 19H» THETAK AT BOTT0M=rF8.3/15H THETaK AT TOPMDL53300 

B39* 4=,F8.3»4Hf Z=»F9.3,8H» ALPhA=»F4.1i 7H» BETA=fF4.1, 7H» MDL53400 

040* 5DELX=»E14.8,7H» DEL^Sf £14,8/7H iZM0D=»I3) MOL53500 

541* 919 format (lX»10h Z AT T0P=»F10,4) MDL53600 

b42» 920 format (6H0 ZRL=»F7.3» 18H, UBARL AT B0TT0M=»F8.4»15H» UBARL AT TOPMDL53700 

t)43* l=,F8,4rl8H» SIGAL AT b0TT0Ms»F8,5, 15H» SI6AL AT T0P=»F8,5/17H SIGEMOL53800 

t)44* 2L AT bottoms, F8,5»i5H» SIGEL AT T0P=»F8,5»19H» THETAL AT BOTTOMS »FMDL53900 

b45* 38,3, 16H, THeTAE AT T0Ps,F8,3»7H, TAULs,F8.3/7h TAU0Ls,F6,3»8H» ALPMDL54000 

B46* 4Hu=,F 4,1»7H, BETLs,F4.1,7h» TASTs,E14.8i 7H» JB0TS,I2,7H» JTOP=,I2)MUL54100 

b47» 921 format (18H0 UBmRE AT BOTTOMS, F8. 4, 15h, UBARL AT T0Ps,F8.4» 16H, SIMDL54200 

b48# IGaL at bottoms, f 8, 5 »lbH» SIGAL aT T0P=,F8.5/17H SiGEL AT BOTTOMS, FMOL54300 

&49* 28,5, 15H, SIGEL AT T0P=,F8,5, 19H, THETAL AT B0TT0M=,F8,3r l6Hr THETAMOL54400 

bbO* 3L AT T0P=,F8.3r7H, TaULs,F8,3/7h TAU0Ls,F8,3,6H, ALPHLs,F4.1»7H» BMDL54500 

^ bbl* 4 ETLs»F4,1,7h, TaST=»E14,8,7H» JbOT=,I2,7Hi JT0P=»I2) MDL54600 

bb2* 922 format ( IHO , 56HCALC0LATED INPUT PARAMETERS FOR MODELS 1,2,3 UMDL54700 

bb3* IBmR =,F10.5,9H» THETA s,F10.5,1oH, DELTHP =,F10,5,8H, DELU s,F10,5MDL54800 

bb4^ 2/lX,09H, SIGAP =,F10.S»9H, SIGEP =,FlO,5) MOL54900 

bb5* 923 FORMAT (1H0,63HCALCULATEQ INPUT PARAMETERS FOR LAYER CHANGE MODEL MDL55000 

bbb* 14 ♦♦♦ UBAR =,F10.5,9H, THEJA =>Fl0,5,10H, DELTHP =,F10.5/1X,8H DEMOL55100 

bi>7* 2LU =,Fl0.5»9Hf SIGaP s,F10,5,9H, SIGEP =,F10,5) MDL55200 

bS>8# 925 format ( IHI , 56X, 15HSUMMARY OF RuNS/l3lH R VEHICLE DAMDL55300 

559* ITE TIME M CONST- OLD RISE RANGE AZIMUTH HEIGHT LAYER LMbL55400 

bbO# 2AYER MaX PEAK MAX MaX PEAK/3H U,20X»098HMO DY YR MOL55500 

bbl* 3 0 ITUENT HEIGHT TO TO OF BOTTOM TOP MDL55600 

bb2* 4 COnC DOSAGE »Fb.l,bH M1N./3H N,28X,8H(HR"Z) 0,10X,51H(M) MDL55700 

bb3* 5 MAX PEAK MaX PEAK CALC, (M) (M) , a8»A3,2A6»10H TIME MDL55800 

bb4^ 6MEAN/38X»1HE»18 x,22HC0NC CONC (M) ,46X»4HC0NC/36X, 1HL» 18X»MDL55900 

bb5* 73h(M) »bX»5H(DE6) ,51 X,a6,A3/IX,65(2H— ) ) MOL56000 

5b6* 926 format { 1H1 , 56X, 15hJ>UMMARY OF RuNS/113H R VEHICLE DAMDL56100 

b67* ITE TIME M CONST- CLD RISE RANGE AZIMUTh HEIGHT LAYERMDL56200 

bb8* 2 layer max PEAK/oH U,20X,38HMO DY YR 0 XTUENT HEIGHT MDL56300 

b69* 3 T0,11X,2HT0,8X,22H0F BOTTOM TOP »A6,4H DEP/3H N»28X,8MDL56400 

b70* 4H(HR-Z) D»10X,56H(M) MAX PEaK MAX PEAK CALC, (M) MDL56500 
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^ 71 * 

572* 

573» 

&74* 

575* 

576* 

577* 

578* 

579* 


5(M) »A6»a3/38X»1HE»16X,a 6»6H DtP »A6»12H DEP (M)/38X»lHLr2MDL56600 

60X»3H(M) »7X»5H(DE6)/XXr58(2H— ) ) 

927 format (iXf l2^ iXf 3 AO » l3 » 2 ( IH/ fl2)fl5rI3flXf A6 »F6»2»F10»2»F11*2 ^ F12MDL56800 

l,2»2F8.2»Fli.3) ^ ^ 

928 format {lX»l2flX»3A8»l3»2UH/»l2)»I5»I3tlXfA6,F8*2»F9.2»F8.2»F10.2MOL57000 

1»F8,2»F9.2»3F11,3) MDL57100 

929 format (53X,2FU*2»F12,2»2F8,2»FU.3) MDL57200 

930 FORMAT (54X,F9.2»F8t2»Fl0,2»F8.2»F9,2»3Fll.3) MDU57300 

STOP MDL57400 

END MDL57500 
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!♦ 

£♦ 

3« 

4+ 

5» 

6« 

7* 

8>t< 

9* 

10* 

!!♦ 

IZ* 

13* 

14« 

15* 

1641 

17t 

18* 

19* 

20* 

iil* 

Ji3* 

ii44t 

as* 

a64c 

a?* 

as4c 
a9« 
30* 
31 + 
324> 
33* 
34« 
35* 
364c 
374c 
364c 


SuBKOUTINE KEADERf VERSION 6, REVISION 0 

SUBROUTINE HEADER (iFF) RDROOlOO 

Common /paramt/ testno( 12 ), iskipus) »nxs»nys»nzs»ndi»nci» RURocaoo 

lNbK>NPTS»NVb»NVB»XX(4i) fYY(41) »Z(16) »DELX(15) »OELY (15) ,Q(l5 ) , RtJR00300 

aUbARKUe) »SiGAK( 16) rSIOEKUb) »SlSX0(15) » SIGYO ( 15) » SIGZO ( 15) » ROR00400 

3ALPHA(20) »BETA(aO) , ZRK » TIMAV » TH eTaK (16) » TAUK » TAUOr » H » XRY » XRZ » RDR00500 

4XeRY»XLRZ»ZZL(40) »IZM0U(15) ^DECaY f ZLIM , TIMl > LAMBDA »DI ( 10 ) , Cl ( 10 ) » RUR00600 
5 TaST( 05) » JBOT(05) » jTOPCOS) i VS (20 ) »PERC (20 ) » ACCUK » VE (20 ) » PeRCB (20 ) » RDRC0700 
6Hd»ALPHL( 05) fbETL(Ob) f TAU l»TAUOL»ZRL»UBARL( 10) »SIGAL(10) »SIGEL(10)RDR00800 
7»THETAL(10) ,GMMMAP(iiO) »NTlrTI(lg) »NPS»NAMCAS(12) RDR00900 

COMMON /PARAMS/ UBaR (20 ) » SIGAP (20 ) ,DELTHP ( 20 ) » SIGEP (20 ) » ThETA ( 20 ) »RDR01000 
1DELU(20) »V£R,VREFfPEAKD»SlGZrSlGYrSIGX»S0R2P»L»THrI»J,KK»ST01» RDROllOO 

2S 1 02f ST03 » THD » ILK » RAD » NNZ , ITOP » IBOT » XAST (21 ) » SIGXNK t JF » PPWR » QPWR > RDR01200 
3MPWR » 1 1 , DEP , XBARX » S^BAR » NXC I ► LA'f t S IGYNK t GAMMA ( 20 ) r NCC , NDD , NTT , RDRO 130 0 

4NCCC » NDDD t NlTT t NSW2 » MODES ( 15 ) » KbW ( 5 ) ► LINES > IMl » MDLS » NWD t RUR01400 

5YSV(41) ,YbAKY(4i) » UbARMK (41 ) » BETANK (41 ) »ALPHNK(4l) »ANG(42) » RDR01500 

6Si6ENK(4l) rbIoANK(c+l) »0EPN(4lr4l) ,RNG,AZM, IDATE(2) » ITIME ( 2 ) » YT » RDR01600 

7NYSS»CDAMX(3) RDR01700 

C This SUBROUriNE reads all INPUT DATA AND CALCULATES NECESSARY RDR01800 

C layer PARAMETERS RDR01900 

integer TtSTNO RDR02000 

REAL MPWR»LfLAMBDA RDR02100 

dimension XbV(41 ) »iZR1(1) RDR02200 

COMMON /LOCALS/ BLaMDA > TEMPK ( 16) » TEMPL ( 10 ) f NSND » M eTDAT ( 3 ) r NVHCL» RDR02300 
1 NMOuL»NPLimT RDR02400 

dimension NTFb(2) RDR02500 

common /PlTiSO/ SCL»XMAXlN»YMAXlNfXSIZE»YSlZEfRASTIN> JSW RUR02600 

common /PuTlLO/ ISwf XMAXJN,YMAX oN,XCIZE»YC1ZE RDR02700 

E0UiVALENCE(NTFB» ITOP) RDR02800 

EoUiVALENCE UZRlrlSKIP) RDR02900 

data YSV/-35. »-30. ,-2b. »-22* »-l8. *-15. ,-12* »-10. »-8. r-6. >-5. »-4.» RDR03000 
1-3.,-2,5*-2. *-1.5,-l. *-.75*-.5*-.25*0.,.25, ,5* .75,1. rl.5*2,*2.5* RDR03100 

23. . 4. *5, *6, *0. *10. *12. *15. ,18. *Z2. *26, *30. *35,/ RDR03200 

Data XSV/25, *100. *200, *400, *600. *b00. *1000. *2000. *3000. *4000. * RUR03300 

1500U. *6000, *7000. *8000, *9000. *10000. *11000. *12000. *13000. ,14000.* RDR03400 

215000. * 16000. * 17000. >18000. *20000. *22000. *24000, *26000, *28000. , RDR03500 

330000. . 32000. *34000* >36000. *38000, *40000. *42000. *44000, *46000, , ROR03600 





450000, » 65000. » 60000./ 


RDR03700 

HO* 

C 

Machine deplndent statement assumes six 

BYTES/WORD 

RUR03800 

<+!♦ 


DmTa TESTN0/12+6H / » NAMCaS/12*6H 

/ 

RDR 03900 

42* 

C 

SK12I = 1.0/SQkT(12.0) 


RDR04000 

43* 


NAMtLIST /Name/ TESTNOrISKlPfNXS.NYS.NZS 

.ndi.nci.npts.nti.ti. 

RDR04100 

44* 


INVS . NV3 . XX . Y Y . Z . DEL>^ » uELY , Q . UbARK . S IGAK . 

sigek.sigxo.sigyo,gammap» 

RDR04200 

45* 


2SIGZ0, ALPHA, BtTA.ZRN.TIMAV.THETAK.TAUK.TAUOK.H.XRY.XKZ.XLRY.XLRZf 

RDR04300 

46* 


3ZZL , IZMOD . decay . T IM l . bLAMDA . D1 . C I . TAST , ZLI M . HB . PEKC6 » VB . 

RDR04400 

47* 


4VS .'PERC . ACCUR . ALPHL » BETL . T AUL . TaUOL » ZKU . 

ubarl.sigal.sigel.thetal. 

RDR04500 

48* 


5NPS . NAMCAS . SCU . XMaX AN . YMAX IN . ISW . XMAX JN . 

YMAXJN.RASTIN 

RDR04600 

49* 


6.XS1ZE.YSIZE.XCIZE.YCIZE.TEMPK.TEMPL.JSW 


RDR04700 

bO* 


7 » iM VHCL . METDaT . NSNU , NMODL . NPLNT 


RDR04800 

bl* 


IP (IFF .GT. 1) GO TO 2 


RDR04900 

b2* 

c 

ZERO OUT INPUT LlST^ FOR PROCESSORS WHERE CORE IS NOT 

RUR05000 

b3* 

c 

Initialize to zero, 608 is the length of 

COMMON /PARAMT/. SUBTRACTRDR05100 

b4* 

c 

IZ FOR TESThO And i2 for namcas 


RDR05200 

b5* 


DO i 1=1. bSH 


RDR05300 

bb** 


1 IZKi(I) = 0 


RDR05400 

b7* 


2 CONTINUE- 


RUR05500 

b6* 


call TAPEIN(IFF) 


ROR05600 

b9* 


IF (IFF ,NE, 0) GO TO 3 


RUR05700 

faO* 


RETURN 


RDR05800 

bl* 


3 CON’IINUE 


RDR05900 

62* 


DO 71 1=1.20 


RDR06000 

63* 


71 GAMMA(I) = 1,0-GAMMAP(I) 


RQR06100 

64* 


NNZ = NZS-l 


RDR06200 

66* 


LmMbDA = BLaMjA 


RDR06300 

66* 


NCC = NCI/IO 


RDR06400 

67* 


NuD = NDl/lO 


RURC6500 

68* 


NTT = NTI/lO 


RDRC6600 

69* 


NCCC = NCi-NCC*10 


RDR06700 

70* 


NoDD = NDI-NDu*10 


RDR06800 

71* 


NTTT = NT1-nTT*10 


RUR06900 

72* 


IF (XSIZE .LE, 0,0) XSIZE = 5,5 


RDR07000 

73* 


IF (YSIZE ,LE. 0,0) YSIZE = 5.5 


RDR07100 

74* 


IF (XCIZE ,lE, 0,0) XOIZE = 5,5 


RDR07200 

75* 


IF (YCIZE ,LE, 0,0) YClZE = 5,5 


RDR07300 

76* 


IF (ISW .LE. 0) ISrt = 2 


RDR07400 
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77* 

cc 


78* 


Hast IN = x.o 

19* 

cc 

If (RASTIN ,Lt_. O.o) KASTli,! = 

80* 

Cc 

Xi.l4E = 937,0 

81* 

cc 

Y5IZE = 899.0 

82* 

cc 

XciZE = 937.0 

83* 

cc 

YCIZE = 899,0 

84* 


IF (NXS .67, 0) GO TO b 

85* 

c 

QuFaULT Xa 

86* 


ImaS = 41 

87* 


Du H I=l»NXb 

88* 


4 XX(1) = XSV(I) 

89* 


5 continue 

90* 


If (TaUOK »bT, u.O) GO TO 6 

91* 

c 

default TaUOK 

92* 


TAUOK = 600.0 

93* 


6 Continue 

94* 


8 Du 16 IrlfNNZ 

9b* 

c 

default SXGYO 

96+ 


IF ISIGYO(I) ,GT. O.C} go TO 

97* 


SiGYO(I) = blGXu(I) 

98* 


9 CuNjINUE 

99* 


IF (ALPHA(I) .Gl. 0.0) GO TO 

xUO* 

c 

DlFAULT AcPhA 

iui* 


AoPhAd) = 1.0 

1U2* 


10 IF IBETAU) .GT. 0.0) 60 TO 1 

iU3* 

c 

DtFAULT beta 

1U4* 


bcTAd) = 1.0 

105* 


12 CONTINUE 

aU6* 


IF aZMODd) .GT. 0) GO TO 16 

107* 

c 

default umod 

108* 


IZMoDd) = 1 

XU9* 


16 CONTINUE 

110* 


IF (XRY .GT. 0.0) gU TO 16 

111* 

c 

default XKY 

112* 


XKY = 100.0 

113* 


18 IF (XRZ .GT. 0.0) qO TO 20 

114* 

c 

DlFaULT xkz 


RDR07b00 

RQRC7600 

lti3.a RUR07700 

RUR07800 
RDR07900 
RUR06000 
RUR06100 
HUR08200 
RUR083C0 
RUR08400 
RUR08500 
RDK08600 
RUR08700 
RDR0R800 
RDR 05900 
RUR09000 
RDP09100 
RDR09200 
RuR09300 
RUR09400 
ROR09500 
ROR09600 
RUR09700 
ROR09800 
Ri)R09900 
RDRIOOOO 
RURlOlOO 
RUR10200 
RDR10300 
RDR10400 
RDR10500 
RDR10600 
RDR10700 
RDR10800 
R|jRl0900 
RDRllOOO 
RDRlllOO 
RUR11200 



119 


xl5* 



XKZ = 100. C 



RDR11300 

a16* 


20 

IF (TIMaV ,oT. 0 , 0 ) eo to 24 



RUR11400 

Il7* 

C 


DtFAULT TxMaV 



RUR11500 

il8^ 



TxMrtV — 600,0 



RDR11600 

Xl9* 



IF USKIP(5) ,20, 2) UMAV - bbO.O 



RURU700 

x'dii* 


24 

Ir URK ,bT, 0,0) «0 TO 26 



RUR11800 

idi* 

C 


DtFAULT ZkK 



RUR11900 




ZKK =2,0 



RUR12000 

Ld~i* 


26 

CoNi INOF 



RDR12100 

iii4* 



IF (ISKIP(6) ,£vj. u) iSKlH(6) = 2 



RuRl2200 

A<i5* 

C 


CnLCK IZMOD 



KDR12300 

iiib* 



Kbiiii'(2) z 0 



RUR12400 

Ul* 



nlx = 0 



RUR12500 

laa* 



KiX(l) = 0 



ROR12600 

iii9* 



Dw 75 I=lfb 



RuRl2700 

xbo* 



jbOra) = 0 



RuR 12300 

xblK 


7 b 

JTGP(i) = 0 



ROR12900 

x^2* 



Ob b4 I=1 »NnZ 



RUR13000 

Xb3+ 



11 = I2h0u(i)/lu0 



RUR13100 

x:»4+ 



Lc = (I?MODlI)-xl»iO0)/10 



RDR 13200 

xbb* 



Ij = iZMOD(i)-Il + iuO-p*10 



RuRl3300 

1>56^ 



If (I ,GT, i) GO To 27 



RDR13400 

xb7* 



IF (11 ,Nt, 6,AND,i2 ,hE, 6,AKD,Ib ,Nc, 

6) 

GO To 27 

RL/R13500 

ibS* 



KbW(l) = 1 



RuRl3600 

ib9* 



Gu fO 72 



RUR13700 

X40* 


27 

IF (ll,NE,b,AHL,l2,Nt.b,Al\D.I3tNE.5) GO 

TO 

28 

KUK13800 

x4i* 



ZUIM = ZU + X) 



RUR 13900 

X42 + 



Kblft(2) = X 



RUR14000 

145* 



II = I 



KUR14100 

144* 


2b 

xF { I 2 , EO , 5 , Ok , 1 1 • cG , 9 , OH , I 3 ,Eu, 9) GO 

TO 

29 

RUR14200 

i4b* 



If 1 1 2 , ME , 4 , Ai'iO , I X , FiE » 4 , And , I b 4) 

GO 

TO 31 

RUR14300 

X4o* 



If (NdK ,bT, 0) GO 10 bO 



KUR14400 

X47* 


i9 

NoK = l,pK + l 



RuRl4b00 

148* 



OoOr(iMLiK) = I 



KUR14600 

X49* 


bO 

JlOF’(KbK) - 1 



HUR14700 

xbO* 


bi 

N'IAl = 0 



RuR 148 CO 

xbi* 



i'iOULS U ) = X 



RUR14900 

Xb2* 


b2 

i^iAu = MThL+1 



RUR15000 
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1S>3* 


ir (NTAL .GT. 3) bo Tb 33 

RURISIOO 



Ih (11 ,E0. NTAL.0i<.I2 ,EQ. NTAL. OR, 13 .bO. NTAL) 60 TO 33 

RDR13200 

ibb* 


Gu TO 32 

RDR 15300 

ib6* 

33 

Ih (NTAL ,LT. 4) NoOLbd) = NTAL 

RDR15400 

Ab7* 

J4 

CONTINUE 

RDR15500 

lb8* 


U (KSW(2) ,Nc. 1) 60 TO 72 

RDR15600 

ib9+ 


NHTb = xl 

RDR 15700 



Du 70 Izlfli 

RDR 15800 

Ibl* 

/O 

2x.L(I) = ^(j.) 

RDR15900 

162* 


(?u TO 73 

RDR16000 

xb3* 

72 

Ir (NPTS .GT. 0) GO Tu 73 

ROR16100 

ifc>4* 


NRTb = 1 

RDR16200 

ib5* 


Z2L(1) = 0.0 

RDR16300 

Xb6* 

73 

CONTINUE 

RUR16400 

xb7* 


IF (LAMBDA ,Lu. O.Q) oO TO 74 

RDR16500 

Xb8» 


IF (ZLIM .Ll. 0.0) ZLIM = ZUUS) 

RDR16600 

Xb9* 

74 

CuNTINUE 

RDR16700 

170* 


Du 3 b IrljN^iS 

RDR16800 

x7i» 

C 

check MINxMuM limits 

RDR16900 

1/2* 


IF (Sie-AK(I) ,LT. ,b) blGMK(I) = .5 

RDR17000 

x73* 


IF (SIGEK(I) .LT. .1) SIGtK(I) = ,1 

RDR17100 

x74* 


IF (UBaRK(I) ,L1. ,i) UBARK(I) = .1 

RDR 172 00 

X 

Ob 

CONI INUE 

RDR17300 

ifQ>* 


IF (NBK .C.Q, 0) GO 7 0 b7 

RUR174C0 

X77» 


IF (ISKIP(7) ,bT, 0) uO To 40 

RDR17500 

178* 

C 

olTcRmine Layer change parameters 

RUR17600 

l/9» 


ZrL b ZRK 

RDK17700 

lao^ 


I X = "I 

RDR17800 

ibi* 


Du 38 IslfNbK 

RDR17900 

ib2» 


U = 11+2 

RDR18000 

xU3* 


NTAl = jBuT(I) 

RDR18100 

xti4* 


NiAK = JTUP(I) 

RDR18200 

Ibb* 


UuARL(II) = UbAKKd+TAL) 

RDR18300 

ibb* 


UuAkL(lT+I) = UbAKK (N7 AK+i ) 

RDR18400 

xtt7» 


bxbAL(il) — SIGaK(N)^AL) 

RDR18500 

xb8* 


SiGAL(II+x) = SIGAKINTaK+I) 

RDR18600 

ib9* 


SxGeL(II) = SIGtK(NTAL) 

RDR18700 

190* 


SlGLUai + l) = SIGcR(NIAK+1) 

RDR18800 



TnETAL(II) = THETAKtNlAL) 

RDR18900 


ThElAL(H + l) = 7 HcTAK(hTAK+1) 

RDR19000 


AuPhL(I) = alpha (ImThL) 

RDR19100 


BcTLd) = BtTA(.MTAu) 

RDR19200 


TLMPL(II) = TLHPKUjlAD 

RDR19300 


TuMPLdl + l) = TtMPK(NTAK+i) 

RD«19400 

J8 

continue 

RUR19500 


TaUoL = tauok 

RDR19600 


TrtUu = TAUK 

RDR19700 


60 TO 52 

RDR19800 

40 

continue 

RUR19900 


IF (TaUOL ,6T, 0.0) 60 TO 42 

RDR20000 


UuFaULT TaUuL 

RDR20100 


TaUoL = 600,0 

RDR20200 

42 

IF (ZRL .oT, O.U) GO TO 44 

RUR20300 


default zkl 

RUR20400 


ZKL = ZRK 

RDR20500 

44 

DO 48 I=lfNbK 

RUR20600 


Ir (ALPHL(I) ,GT. 0*0) GO TO 46 

RUR20700 


DtFAULT AuPhL 

RUR20800 


ALPhL(I) =1.0 

KDR20900 

4b 

IF (BETU(I) .GT. 0.0) GO TO 48 

RDR21000 


default BuTl 

RUR21100 


Dc.Tl(I) = I.O 

RDR21200 

48 

CONfiNUE 

RUR21300 


NTAL = 2*i^lB^ 

RUR21400 


Do 50 1=1 » NTAL 

RUR21500 


CriEcK MINIMUM VALUED 

RDR21600 


IF (SIGALd) .LT. .b) SIGAL(I) = .5 

RDR21700 


IF (UuARLd) .LT. .1) UBAKLd) = .1 

RDR21800 


IF (SIGELd) .LT. .1) SIGEl(I) = .1 

RDR21900 

bO 

Continue 

RDR22000 

52 

NIAK = NNZ+l 

RDR22100 


NTAl = NNE+nBK 

RDR22200 


CoMblNE AuPhA AND tiLTA WITH ALPmL AND BLTL 

RDK22300 


DO 54 1=NTAN»NTaL 

RDR22400 


Ii^N.i = I“NN^ 

RUR22500 


AuPhAd) = MLPHLdNNZ) 

RDR22600 






bi-lAd) = F>uTu(iNiM2) 

RUR22700 



b4 

CbN'V XigoE 

RDR22800 



b7 

Cui'Ml INUE 

RDR22900 



bb 

CuNTINUE 

RDR23000 




S'iOi = ( ThUK/ i AUOK ) ♦* ( 0 » 2 ) *RAD 

RDR23100 




s - (2(2)/2 kK) 

RDR23200 

a:>5* 



Si s 1«0 /aL06(S) 

RUR23300 




P = R08(UbAKK(2) ,ubARK(l) »S1) 

RDR23400 

a<i?* 

C 


Calculate Udak fok layer i 

RDR23500 




UbAK(l) = KbU(UBAKRU) »PrZ(2) ,2 Ra) 

RDR23600 



* 

PPhR - P 

RDR23700 

£140* 



It (NNZ .uT. 2) bO TO 152 

RDR23800 

241* 



Uu 150 I5s2»i\l'i£. 

RUR23900 

242^ 

C 


CmLcULATE UoAK fok layers 2 TO nNZ 

RDR24000 

£i43» 


IbO 

UbAnd) = 0,5*(uBAKKd + l)+UbAHKd) ) 

RDR2'+100 

c44* 


lb2 

P = Rbb(SiGAKU) »SI0AK(1) »S1) 

RDR24200 

24b* 

c 


CALCULATE SiGmP FOk LmYER 1 

RDR24300 

24b* 



SiGAPd) = STu1*Rd11(SI6AK(1) »P»Z(2) »ZRK) 

RQR24400 

247* 



MP'wK - P 

RDR24600 

*;4d* 



If (NNZ .bT. 2) GO TO lb2 

RDR24600 

249* 



SI02 - RAu*(TAUK/b00.0) **,2 

KDR24700 

£.50* 



DO x60 I=2 hmN2 

ROR24800 

2bl* 

c 


Calculate sigmP for layers 2 to nnz 

RDR24900 

2b2* 


ioO 

SioAPd) = U.b*ST02*(5I6AKd+l)+5lGAK(I) ) 

RDR25000 

2'o3* 


lu2 

P = Rbb(Sl6tK(2) ,Sl&Ervd) rSl) 

RDR25100 

2b4* 

c 


Calculate siglp fok layer 1 

RDR25200 

2bb* 



SiGEPd) = KBlKSioLKd) fP,2(2) ,2HK)*KAD 

RDR25300 

2b6* 



IF (NNZ .uT. 2) GO TO 172 

RDR25400 

2b7* 



OP'aR - P 

RDR25500 

2b8* 



DO l70 I=2 m^N2 

RUR25600 

2b9* 

c 


Calculate sigcP Fok layers 2 to nnz 

RUR25700 

2b0* 


170 

SiGtPd) - ( (SlGEK(I + l)+Si6EK(I) )*RAD)*0.5 

RDR25800 

2bl* 


172 

Do 180 1=1 » NNZ 

RUR25900 

£b2* 



J = I 

RDR26000 

2b3* 

c 


Calculate Tmeta for all layers 

RDR2fol00 

2b4* 



TnElA(I) = U.5*(ThElAK(J+l)+THETAK(J) ) 

RijR2b200 

2b5* 



IF (ABS(ThE1 AK(J+1 )-TF(ETAk(J) ) ,GT, 180,0) THETAd) =THETA(I)- 

RDR26300 

2bb* 



1180.0 

RDR26400 



123 


2b7» 

C 


CrtUULATE D£LTHP FOH ALL LAYERS 

RDR26500 

ebb* 



DLLTHP(I) = THETAK{3+1)-ThETAK(J) 

RDR26600 

2fa9* 



IF (DELTHP(I) ,6T. 180.0) DELTHp(X) z 360 . 0-DELTHP ( I ) 

RDR26700 

e70* 



IF (DELTHP(X) ,lT. -160,0) DELTHP ( I ) z 360 . O+DELTHP ( I ) 

RDR26800 

271* 


180 

CONTINUE 

RDR26900 

272* 



DU 185 I=lrNN2 

RDR27000 

^ri* 

C 


calculate DLLU FOR ALL LAYERS 

RDR27100 

274* 



DLLU(I) = UBAKK(I+1)-UBARK(I) 

RDR27200 

2/5* 



IF (DELU(I) ,GE, 0.0) GO TO 185 

RDR27300 

Zlb* 



IF aeWPXa + D-TEMPKd) .GE. O.O) go to 185 

RDR27400 

277* 



DELU(I) = AdS(DELU(I)) 

RDR27500 

Zlb* 


18b 

CONTINUE 

RDR27600 

279* 



IF (KSW(l) ,GT, 0) SO TO 250 

RUR27700 

2bO* 



IF INBK .EQ. 0) GO TO 250 

RDR27800 

2til* 



STOl z (TaUL/TAUOL)**(0.2)*RAD 

RDR27900 

2b2* 



M z JTOP(l) 

RDR28000 

253* 



IF (JBOT(l) ,ST, 1) GO TO 186 

RUR28100 

254* 



S z {Z(M+1)/ZRD 

RDR28200 

205* 



SI z 1,0/ALOG(5) 

RDR28300 

206* 


186 

IF (ISKIP17) .GT. 0) GO TO 192 

RUR28400 

207* 



DO 188 I=1»nBn 

RDR28500 

208* 



NNZI z NNZ+1 

RDR206OO 

209* 



Ml z JBOTd) 

RUR28700 

290* 



M2 z JTOP(I) 

RDR26800 

291* 



S z 0.0 

RDR28900 

292* 



DO 187 J=M1,M2 

RDR29000 

298* 


187 

S z S+0,5*(UBARK(J)+UbARK(j+l) )*(Z(J+1)-Z(J) ) 

RUR29100 

294* 



U6AR(NNZI) z S/(Z(M2+1)-Z(M1) ) 

RDR29200 

295* 


188 

CONTINUE 

RDR29300 

296* 



GO TO 202 

RDR29400 

297* 


192 

CONTINUE 

RUR29500 

298* 



IF (JBOT(i) .GT, 1) GO TO 193 

RDR29600 

299* 



P z RB8(U6AKL(2) fUBARLd) »S1) 

RDR29700 

OUO* 

C 


Calculate ubak for new layer i dF contains surface) 

RDR29800 

301* 



UbAK(NNZ+l) = Rb11(UBaRL(1) »P»Z(M+1) ,ZRL) 

RDR29900 

302* 



QPWR z P 

RDR30000 

303* 



Go TO 197 

RUR30100 

304* 

C 


CALCULATE UbAK FOR NEw LAYER 1 (IF DOES* NT CONTAIN SURFACE) 

RDR30200 



124 


^U5« 

3U6« 

oU74= 

JU84c 

Jll* 

jl3# 

315 * 

316 ^ 

317* 

318* 

319* 

320* 

321* 

322* 

323* 

324* 

325* 

326* 

327* 

328* 

J29* 

330* 

331* 

332* 

333* 

334* 

335* 

336* 

337* 

338* 

339* 

340* 

341* 

342* 


193 U3AH(NNZ+1) = (U8ARI-(1)+UBARL(2) )*0.5 
197 IK (NbK .lT, 2) GO TO 202 
DO 200 I=2»,nBK 
J = 1*2-1 

C CALCULATE UbAK FOR NEW LAYERS 2 TO NBK 
NWZI = NNZ+1 

200 UdAH(NNZI) = (UBARl( J+D+UbARL( J) ) *0.5 
202 IF (JBOTU) .GT, 1) GO TO 210 
P = R68(SIG£L(2) »SIGEL(1) »S1) 

c Calculate sigep for new layer i (If contains surface) 
SiGtP(UNZ+l) = RBlKSIGELd) rP»Z(M+l) »ZRL)*RA0 
Go TO 215 

C calculate SIGEP FOR NEW LAYER 1 (IF DOES’NT CONTAIN SURFACE) 
210 Si6£P(NNZ4l) = ( (SlGEL(2)+SIGELa) )*RAD)^0,5 

215 IF (NBK .LT, 2) GO TO 217 
Du 216 1=2 r NBK 

J = 1*2-1 

C calculate SIGEP FOR NtW LAYERS 2 TO NBK 
NwZi = MNZ+I 

216 SiGEP(NNZI) = ( (SIGEL { J+1 ) +SIGEL ( J ) ) ♦RAD) *0 . 5 

217 IF (ISKIP(7) ,GT. O GO TO 226 
DO 225 1=1 f NBK 

C calculate ThETA for new layers 1 TO NBK 
NimZI = NNZ+l 
Mi = JBOT(I) 

M2 = JTOP(I) 

T1 = THETAK(MI) 

ANG(Ml) = 'Tl 
S = 0,0 

DO 222 J=M1,M2 
T2 = THETAK{J+1) 

IF (ABS(T2-|1) .L£. 160.0) GO TO 221 
IF (T2 ,61'. Tl) GO TO 220 
T2 = T2+3G0.0 
GO TO 221 

220 T2 = T2-360.0 

221 P = 0.5*(T2+T1) 

Tl = T2 


RDR30300 

RDR30400 

RDR30500 

RDR30600 

RDR30700 

RDR30800 

RDR30900 

RUR31000 

RDR3U00 

ROR31200 

RDR31300 

RDR31400 

RDR31500 

RUR31600 

RDR31700 

RDR31800 

RDR31900 

RDR32000 

RDR32100 

RDR32200 

RDR32300 

RDR32400 

RDR32500 

RUR32600 

RDR32700 

RDR32800 

RDR32900 

RDR33000 

RDR33100 

RDR33200 

RDR33300 

RDR33400 

RDR33500 

RDR33600 

RDR33700 

RDR33800 

RDR33900 

RDR34000 



125 


3H3* 


ainig(j+ 1 ) = n 


RDR34100 


222 

S = S+P*(2(j+1)-Z(j) ) 


RDR34200 



THETA (NNZI) = S/|Z(f'i2+l)-Z(Ml) ) 


RDR34300 

346* 


T1 - 0,0 


RUR34400 

347* 


T2 = 0.0 


RDR34500 

34B* 


M2 - M2+1 


RDR34600 

349* 


DO 223 J=M1,M2 


RDR34700 

3b0* 


Ti = T1+2(J/ 


RDR34800 

3bl* 

223 

T2 = T2+ANG(J) 


RDR34900 

3b2# 


P = 1.0/FLOaT(M2-M1+1) 


RDR35000 

3&3* 


T2 = T2*P 


RDR35100 

3b4* 


n = n*p 


RDR35200 

3b5* 


p = 0.0 


RDR35300 

3b6* 


S = 0.0 


RDR35400 

3b7* 


DO 224 J=M1»M2 


RDR35500 

jb8* 


P = P+(Z(J)-Ti)*(AiMb(o)-T2) 


RDR35600 

3b9* 

224 

S = S+(Z( J)-T1)**2 


RUR35700 

3bO» 


DtLTHP(NNZI) = (2(ivi^)-Z(Hl) )*P/S 


RDR35800 

361* 


IF (DELTHP(NN2I) .6T. 180,0) DElTHP (NImZI ) 

= 360, C-DELTHP (NNZI) 

RDR35900 

362* 


IF (DELTHP(nN2I) ,lT. -180,0) DELTHPUmNZI) 

= 360. 0+DELTHP (NNZI) 

ROR36000 

3t>3* 

225 

CONi IIMUE 


ROR36100 

3b4* 


GO TO 230 


RDR36200 

jbb* 

22b 

DO 227 I=1»nBK 


RUR36300 

356« 


J = 2*1-1 


RDR36400 

3b7* 


NhZI = NN2+i 


RDR36500 

jb8* 


ThETA(NMZi) z 0,5 *(TH£TAL( j+1)+THETAL(J) ) 


RDR36600 

ob9* 


IF ( aBS ( THETaL ( J+1 ) -THtTAL ( J ) ) , 6T . 180 . ) THETA (NNZi ) zTHETA (NNZI ) +180 

.RDR36700 

370* 


DfcLIHP(NN2I) = THETAL(J+1 )-THETaU(J) 


RDR36800 

371* 


IF (DELTHP (NNZI) ,GT. 180.0) DElTHPCNNZI) 

= 360, 0-DELTHP (NNZI) 

RDR36900 

372* 


IF (OELTHP(NNZI) ,lT. -180.0) DELTHP(NMZI) 

= 360. O+OELTHP (NNZI) 

RDR37000 

373* 

227 

CONTINUE 


RDR37100 

374* 

230 

CONTINUE 


RUR37200 

375* 


Do 235 I=i»NBK 


ROR37300 

3 /6* 


J = 1*2-1 


RDR37400 

3/7* 


NimZi = MNZ+I 


RDR37500 

378* 


IF (ISKIP(7) ,NE. OJ 00 TO 233 


RDR37600 

379* 


Ml = jaoT(I) 


RDR37700 

obO* 


M2 = JTOP(I) 


RDR37800 



Ti = 0.0 
T<i z 0.0 
Ow eLZX 

Ti z Ti+UaAn;K(J) 

Id = T2+Z(J) 

P = 1,0/Fl0aT(!''12-Ni1 + 1) 

Tl z T1*P 
= T2*P 
P = 0,0 
S = 0.0 
uo ii3td 

P = P+(Z( J)-T2)*(UdARK(J)-Tl) 

232 S = S+(Z(J)-T.;)*t2 
DtLu(NNZI) = (ZlM2)-Z(Ml) )+P/S 
(iu 10 234 

233 CONTINUE 

Dc.LU(NNZl) = UBARL( J+1)-U8 aRL( J) 

234 Continue 

IF (DELU(ImNZI) .GE. 0.0) bO TO 23b 
IF (T£MPL(J+1)-T£MPL(^) .bT. 0.0) GO TO 235 
OLLUdMNZI) = hBS(ulUU(NN2I) ) 

235 Continue 

237 IF iJbOT(l) .bT. 1) GO TO 242 
P = RB0(5iGAL(2) »S1 GAl( 1) rSl) 

Calculate Sigap for new layer i (If contains surface ) 
SiGAP(NNZ+l) = STOi*Rull(SlGAL(l) »P»Z(M+1) »ZRL) 

Go TO 243 

Calculate sigap for Ntiv; layer i (if does’nt contain surface) 

242 sroi = RAo*(TAUL/b00.0)**,2 
SiGAP(NNZ+l) z 0.5»5TOl*(SiGAL(i)+SIGAL(2) ) 

243 CONTINUE 

IF (NBK ,i-T. d) GO TO 250 

il- (JBOTU) .ES. i) STOi = (TAUL/b00.0)»*,2*RAD 
Do 245 I=2 »nBk 
J = I*2-l 

CmLcULATE SxGaP for Nt-Vv LaYERS 2 TO NdK 
NnZi z nnz+i 

245 SibAP(NNZI) = 0.5»STOl+{SlbAL(J+l)+SlGAL(J) ) 


RDR 37900 
RDR3a000 
RUR38100 
ROR3S200 
RDR38300 
RUR38400 
RDR38500 
ROR3B600 
RLR36700 
RDR3Q800 
RDR36900 
RDR39000 
RDR39100 
RDR39200 
RDR39300 
ROR39400 
RDR39500 
RDR39600 
RDR39700 
ROR39800 
RDR39900 
RDR40000 
RDR40100 
RDR40200 
RDR40300 
RDR40400 
RDR40500 
RDR40600 
RDR40700 
RDR40800 
ROR40900 
RDR41000 
RDR41100 
RUR41200 
RDR41300 
RDR41400 
RDR41500 
ROR41600 


419* 

4iiO» 

‘fiii* 

hH2* 

‘tUd* 

4iib» 

hH7* 

hub* 

4<i9* 

t*50» 

*tbl* 

4i2» 
hbb* 
H'54+ 
•+^5+ 
^ 4<56* 
h^7* 
*+-38* 
4^9* 
h40* 

441 + 
H42* 
445* 
444* 
445* 
446+ 
4*+7* 
■+40* 
449* 
4b0* 
4bl + 


2bo Continue 
D u j9b 

Ih (H ,LE» ii. ( 1 ) ) uU To 39tJ 
39b Continue 

396 Ki'^G = UEL.A(i-i) 

Ac.N = DEL't(i-l) 

CCC GuT DATE aNj 'I I ME (UNiVAC 1106 uNLY) 

Call LHTRaNi9»NTFd(I) iNTFtj(2) ) 

C LuAu MM/DD/YY INTO IDaTEU) AND (2) ON FIRST LOOP 

C Load hK;Mi-,;bC into iTiMEd) and (2) Oi^ second loop 

N = V’ 

Do 4OO l=i»£; 

J = 2*1-1 

CaLu MSFLo(U» 12 rNTFD(l) » 0 ,IDATE(J) ) 

CmLl MSFLU (u»6»N»12» ILATE(J) ) 

CaLl MSFLu( 12»12»NTEB(I) »lb»IuATE(J) ) 

CaLl MSFLu ( 0 » d ♦ I'i » 3 u » ILATE ( j ) ) 

CaLL MSFLo (24 f 12 » NTPD i I ) » 0 » I DATE ( o+l ) } 

4oO CONTINUE 

CCC EhD date aNu time - PRINT uiTn a6,A2 FORMAT 

V»KITE (6»iOuO) NAi-,uAS» (TtSTNO(I) »I = 1»6) » IDATE, ITlME»H,RNG» AZM 
C 

c savl kmFO fok lNo of non summary 

'f'r^IlE' (9) H » Rr>iG » AZM > T xMA V 
Ir IISKIP(8) .£0, i) write (6rhAM2) 

RlI oRN 


RDR41700 

RDR41800 

RUR41900 

RDR42000 

RUR42100 

RDR42200 

RDR42300 

RUK42400 

RDR42500 

RDR42600 

RDR42700 

RDR42800 

RDR42900 

RDR43000 

RDR43100 

RDR43200 

RUR43300 

RDR43400 

RDR43500 

RDR43600 

RUR43700 

RUR43800 

RUR43900 

RDR44000 

RDR44100 

RDR44200 


lOUO FoRwiAT (lril»ll (/) , 24X , 21 (4h**** ) /24X » IH* » B2X » 1 h*/24X » IH* » bX » 12AG ► DRUR44300 
IXf lrt*/24X»lh*r82X»ih*/24Xrlh*»23Xr6A6,23Xf 1H*/24X,1H*»82X,1H*/ RUR44400 

1 24X,lH*f25X,7HDATE = ,A6>A2,9h» TIME = fRDR44500 

2Ao,A2f25XdH=»'»3(/24X»lH*»b2X»lH»)/24X»30H* ADJUSTED CLOUD RISE HE1RDR44600 
36nT =,r8.2»9H» RAuOc =>F9.2»19H, AZIMuTH BEARING =»F7.2»2h +/24X» 1RDR44700 
4H»»b2X»lH+/24A>2l(4H*=f**)/lHl) RDR44800 

EuD RUR44900 



SUBROUTINE TAPEIN, VERSION 6 , REVISION 0 


SUBROUTINE TAPEIN (IFF) 

COMMON/PARAMT/ TESTN0U2) rlSKlPUS) »NXS»NYS»N2S»NUI rNCI » 
1NBK,NPTS»NVS»NVB»XX(‘*1) »YY(41) »2(16) rUELXdS) ,DELY (15) |0(15) » 
2UDARK(l6)>SlGAKa6)»SlSEK(16)»Sl(5X0(15) »SI6Y0(15) rSIOZOUS) » 
3 ALPhA( 20) »BETA(20) rZRK»TlMAV»TH£TAK(16) »TAUK»TAU0K»H»XRY»XR2» 
4XURYfXLRZrZ2L.(40) d^MODdS) »0£CAY>ZLlMrTIMlrLAM60A»0I (10) fCI (10) f 
5TAST(05) » J0OT(O5) »JT0P(05) ,VS(20) »PERC (20) »ACCUR»VB(20) »PERCB(20 ) j 
6HB»ALPHL(05),8ETU(05) »TAUL,TAUOl»ZRL»UBARL(10) »SISAL(10) »SIOEL(10) 
7,THeTAL.( 10) »GAMMAP(20) fNTi ,TI UO) »NPS»NAMCAS(12) 
common /locals/ BLAMDA»TEMPK(16) ,TEMPL(10) »NSND»MeTDAT(3) »nvhcl» 

1NMOoL»NPLNT 
dimension MeTuTC(3) 

COMmON/PLTLLO/ ISW»XMAXJN,YMAXJNfXClZE»YCIZE 
COMmON/PLT ISO/ SCL t XMAXIN , YMAXIN » XSIZE f YSIZE » RAST IN » USW 
dimension IVHCT(3»5) *IPLNT(4) 
data IVHCT/6HTITAN r6hlll C » 

1 6HSPACE »6HSHUTTL»5HL » 

a 6H0ELTA^»6HTri0R 2»5H914 , 

3 6HmINUTE#6hMAN Il»5H » 

4 5HDELTA*»6hTH0R 3,6H914 / 

data IPLNT/6HHCL »&HCO »6HC02 »6HAL203 / 

dimension ICARDU4) 

NAMELIST/NAM2/ TESTNOdSKlP»NXS»NYSrNZSrNDI »NCI »NPTS»NTI »TI » 

INVS ,NVB , XX dY » Z » DELX » DELY , Q r UBARK , SIGAK » SIGEK r SIGXO » SIGYO , GAMMaP» 
3SI GZO » ALPHA , BETA » ZRK » T IMA V , THETaK , TAUK , TAUOK » H » XRY » XRZ f XLRY » XLRZ » 
32ZL,I2M0D»DECAY»TIMl»BLAMDA»Dl»cIrTAST»2LIM»HB»PERCB»VB» 

4 VS » PERC » ACCUR » ALPhL > BETL » T AUL » T aUOL » ZRL ,UBARL » SiGAL r SISEL r THET AL » 
5NPS,NAMCAS» SCL» XMAXIN rYMAXlN»ISttfXMAXJN»YMAXJN»RASTIN 
6rXSl2EdSiZ£,XClZ£»YCiZE»TEMPK»TEMPL»USW 
7 f NVhCL f METDaT » NSND , NMODL f NPLNT 
NVHCLC " vehicle NUMBER 1=TITAN,2=SHUTTLE»3=DELTA-TH0R 2914» 
4=MINUTEMAN II»5=dELTA-TH0R 3914 (II FORMAT COL 1) 

METOTC - met date M0»DY»YR, (312 FORMAT COL 2-7) 

NSNuC - SOUNDING NUMBER (12 FORMAT COL 8-9) 

NMOlOC - model number (13 format col 10-12) 

NPLnTC • pollutant number lsHCLr2=C0»3=C02»4=AL203 (II FORMAT 



69 * 

C 

COL 13) 

TPN03700 

40* 

C 

INUnT - INPUT Unit number (default = 10 » alternate s 5) (12 FORMATTPNO30OO 

41* 

c 

COL, 79-80) 

TPN03900 

42* 


ICOnTN = ICONTN+1 

TPN04000 

49* 


10 CONTINUE 

TPN04600 

44* 


IF .(ICONTN ,GT, 3) 60 TO 60 

TPN04700 

45* 


read (5,1000»£ND=140) NVHCLCr (MeTDTC(U) » J=1»3) ,NSNDC»NM00LC» 

TPN04800 

46* 


INFLNTCflNUNT 

TPN04900 

47* 


IF (XNUNT ,EQ, O) INUNT = 10 

TPN05000 

48* 


IF (NVHCU ,LE. 0) ICONTN 5 4 

TPN05100 

49* 


IF (ICOnTN ,E0, 4) 60 TO 30 

TPN05200 

bO* 


20 CONTINUE 

TPN05300 

bl* 


write ( 6 » 10 1 0 ) N VhCl-C » ( METDTC ( U ) » u=l » 3 ) , NSNDC » NMODLC » NPLNTC » INUNT 

TPN05400 

b 2 * 


write (6»1030) (XVHCT(U,NVHCLC)»J=lf3),(METDTC(U)»U=l»3)»NSNDC» 

TPN05500 

b3* 


1NN00LC» IPUNT (NPLNTC) » INUNT 

TPN05600 

b4* 


IF (INUNT ,E0. 5) 60 TO llO 

TPN05700 

55* 


IF (ICONTN , 6 E, 4) 60 TO 120 

TPN05800 

M *56* 


30 IF (ICONTN ,NE, 1. AND, ICONTN ,NE. 4) 60 TO 50 

TPN05900 

57* 


DEFINE FIlE lOdOOOOOrSOrLf IASV) 

TPN06600 

58* 


REWIND 12 

TPN06800 

59* 


50 continue 

TPN06900 

60* 


IF (ICONTN ,LT, 4) REWIND 12 

TPN07000 

61* 


60 REAU (12»1040,END=130) NVHCL» (MeTDAT( J) »U=1»3) ,NSND»NM0DL,NPLNT» 

TPN07100 

62* 


llSTRTrlEND 

TPN07200 

63* 


IF (ICONTN ,LT, 4) 60 TO 80 

TPN07300 

64* 


NVHCLC = NVhCL 

TPN07400 

65* 


nmoqlc s nmodl 

TPN07500 

66 * 


nplntc = nplnt 

TPN07600 

67* 


NENDC = NSNd 

TPN07700 

68 * 


DO 70 1=1 » 3 

TPN07800 

69* 


70 METdTC(I) = METDAT(I) 

TPN07900 

70* 


60 TO 90 

TPN08000 

71* 


80 continue 

TPNoaioo 

72* 


IF (NVHCL ,NE. NVHCLC) 60 TO 60 

TPN08200 

73* 


IF (METDAT(3) ,NE, FiETDTC(3)) 60 TO 60 

TPN08300 

74* 


IF (METDATU) ,NE, METDTC(D) 60 TO 60 

TPN08400 

75* 


IF (METDAT(2) ,NE, M£TDTC(2)) 60 TO 60 

TPN08500 

76* 


IF (NMODL .NE. NMOOLC) GO TO 60 

TPN08600 


IF (NPLNT ,NE. NPUNTC) GO TO 60 
IF (NSND .N£* NSNOC) GO Tq 60 

HAVE FOUND the MaTCH, EXTRACT THE NAMELIST SET (CARD IMAGES ISTRT 
TO IcNq) from fIuE 10 AND PLACE TH£M ON FILE U FOR NAMELIST READ, 

90 DO iOO I-ISTRTflEND 
lASV = I 

read a0*lASV,l050) ICARD 
WRITE (11»1050) ICARD 
100 CONTINUE 
ENOFILE U 
REWIND 11 
READ (11»nAM2) 
rewind 11 

IF (ICONTN ,G£, 4) GO TO 20 

no read (5#NAM2) 

ICOhTN = 2 

: SaV£ id info, for summary at end of run 

120 WRITE (9) (lVHCT(I»NVhCLC),I=lf3)»(METDTC(I)fI=l»;5)»NSNDCfNM0DLC» 
IIPLnT(NPLNTC) 
return 

130 IF (ICONTN ,G£, 4) GO TO 140 
WRITE (6rlO02) 
read (5,NAM2) 

GO TO 10 

140 write (6^1003) 

NFS = 1 
IFF = 0 
RETURN 

1000 F0RMAT(Il»3l2,I2fl3»Il»65X,l2) 

1002 format (1H ,49H*>t‘ ERROR ^ NO DATA ON TAPE FOR THE ABOVE CASE **) 

1003 format (lHlr2lH***^ END OF DATA ♦*♦♦) 

1010 F0RMAT(lHi#29X»2lH CASE CARD ♦♦♦r/lH » Hr3l2» I2»l3r Ilf 

1 65Xfl2f//) 

1020 F0RmAT(2I10) 

1030 FORMATdH »8 HvEHICLL=» lX»3A6f /iH f 

1 l7hDATE OF MET DATA=flXf I2f lH/,I2flH/,l2f/lH » 
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115* 

il7* 

116* 

119* 

160* 


2 16HS0UNDIN6 NUMBER=» I5»/1H »13hM 0DEL NUMBER=rI5» 

3 /1h flOHPOUUTANTs»lX»A6r/lH t 

4 19HF0RTRAN INPUT UNIT=»I5) 

1040 format (I3r3I2fi2fl3»il,2l6) 

1060 format (13A6»A2) 

END 


TPN12500 

TPN12600 

TPN12700 

TPN12800 

TPN12900 

TPN13000 



i* 

z* 

3« 


SUBROUTINE DEPOSr VERSION 6, REVISION 0 


- 


SUBROUTINE DEPOS 

DEPOOlOO 

= 

4« 


common /PARaMT/ TESTN0(12), ISKIPU5) rNXS»NYS»N2SfNDI»NCI» 

DEP00200 


5» 


1NBK,NPTS»NVs»NVB»XX( 41) fYY(41) »Z(16) »uELX<15) ,DELY(15) rQU5)» 

DEP00300 


6* 


2UBARK(16)»SIGAK(16)»SI6EK(16)»SiGX 0(15) rSIGYO (15) »SIG20(15) » 

DEP00400 


7* 


3AUPHA ( 20 ) » beta ( 20 ) , 2RK » TIMA V » THeTAK (16 ) , TAUK , TAUOK » H » XRY » XRZ » 

DEP00500 


6^ 


4XtRY»XLRZ»Z2L(40)»l2M0D(15 ) »DECaY»21.IM»TIM1»LAMBDA»DI (10) ,CI (10) » 

DEP00600 


9* 


5TAST(05) » JBOT(05) »UTOP(05) ,VS(2o) »PERC(20) »ACCUR»VB( 20 ) rPERCB(20) 

»DEP00700 

_ 

10* 


6HtJrAUPHL(05) »BETL(0S) fTAUL»TAUOL»2RLrUBARU(10) ^SlGALdO) »SIGEL(10)DEP00800 

i 

B 

11* 


7»TH£TAU(10)»GAMMAP(20) »NTI ,TI (lO) »NPS,NAMCAS(12) 

DEP00900 

_ 

12« 


common /PARAMS/ UBAR(20) »SIGAP(20) »DELTHP(20) tSlG£P(20) »THETA(20) 

fDEPOlOOO 

5 

13« 


1DELU(20) »VER»VREF»PE.AKD»Sl6Z»Sl6Y»SI6X»S0R2P»L»THf l» JrKK»St01» 

DEPOllOO 

a 

144c 


2ST02 , ST03 » TRD » I UK » RAD » NNZ » I TOP > IBOT » X AST (21) r SI gXNK » JF r PPWR » QPWR » 

DEP01200 


154c 


3MPWR , II » DEP , X6ARX » SOBAR » NXC I » UAT » SIGYNK » GAMMA ( 20 ) f NCC » NDD , NTT , 

DEP01300 

B 

a 

164c 


4NCCC » NDDD t NTTT » NSW2 » MODUS ( 15 ) » KSW ( 5 ) » UINES » IMl » MDUS » NWD » 

OEP01400 

B 

B 

174c 


5YSV(41) ,YBARY(41) »UBAKNK(41) fBETANK(4i) rAUPHNK(4l) » ANG(42 ) f 

DEP01500 

_ 

184c 


6SI6eNK( 41) »SI6ANK(4l) >DEPN(41»4i) ,RNG»A2M»IDATE(2) »ITIME(2)»YT, 

DEP01600 

1 

194c 


7NYSb»CDAMX(3) 

DEP01700 

i 

204c 

C 

*♦♦* THIS Subroutine caucuuates gravitationau deposition at grounddepoisoo 

i 

214c 

C 


DEP01900 

a 

■ 

224c 

C 


DEP02000 

1 

23* 


dimension DTHK(21) 

DEP02100 

= 

244c 


EOUIVAUENCE (DTHK»XAST) 

DEP02200 

_ 

25* 


REAU MPWR»UrUAMBDA 

DEP02300 

1 

26* 


integer testno 

DEP02400 

m 

■ 

27* 

C 


DEP02500 

- 

26* 


WRITE (6»905) 

OEP02600 

s 

1 

29* 


NBK s 0 

DEP02700 

I 

30* 


DO 10 Isl^NNZ 

DEP02600 

= 

31* 

C 

uisT INPUT Parameters 

DEP02900 

■ 

■ 

i 

32* 


IF (1 .GT. 1) 60 TO 7 

DEP03000 

! 

33* 


WRITE (6»900) I»UBARK(I) »UBARK(I*1)»SIGAK(I)»S1GAK(I+1)»SIGEK(I)» 

OEP03100 


34* 


1S16EK(I+1)»Q(I)»DEUX(I)»DEUY(I) ,SIGY0(I),SIGZ0(I)»AUPHA(I) »BETA(I)DEP03200 


35* 


2 » THETAK ( I ) » TAUK » TAUOK » 2 ( I ) , THETaK ( I +1 ) 

DEP03300 


36* 


GO TO 8 

DEP03400 


37* 


7 CONTINUE 

DEP0350Q 

- 

36* 


WRITE (6»906) I»UBARK(I+1) ,SIGAK(1+1) »SIGEK(I+1) »Q(I) ,DEUX(I) » 

DEP03600 
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59« 

iDtLY a ) » SIGYO ( I ) , SieZO (I ) » ALPHA ( I ) , beta ( I) » Z ( I ) f ThETAK (1+1) 

DEP03700 

40* 

8 

IF (I ,LT, NNZ) 60 TO 9 
WRITE (6r907) ZU+D 

DEP03800 

4].* 


0EP03900 

*f2* 

9 

S16aP(I) = SIGAK(I)*(TAUK/TAUOK)*»(0,2) 

DEP04000 

43* 

10 

CONTINUE 

DEP04100 

44* 


write (6»901) UfVSlI) »I»PERC(I) »I=1»NVS) 

DEP04200 

45* 


write (6»902) a»6AMMAP(I) »I=1»NVS) 

DEP04300 

46* 


IF (NVB .LE, 0} 60 TO 12 

OEP04400 

47* 


WRITE (6»908) HB» (lrVb{I) ,IfPERCB(I) »IzlrNVB) 

DEP04500 

46* 

12 

CONTINUE 

OEP04600 

49* 


THETA (X) s THETaK(I) 

DEP04700 

&0* 


IF (THETA(l) ,LT. 160.0) THET = (THETA (1) +180.0 )*RAD 

DEP04800 

&i* 


IF (THETA(l) .6E. ibO.O) THET = (THETA (1) -180.0) +RAD 

DEP04900 

b2* 


DTHK(1) =0,0 

OEP05000 

53* 


DO 20 N=2»NZS 

DEP05100 

b4* 

20 

DTHK(N) = DTHK(N-1)+DELTHP(N-1) 

OEP05200 

b5* 


NYSS = NYS 

DEP05300 

b6* 


IF (NYS ,6T, 0) 60 TO 23 

DEP05400 

b7* 


S = THETA(1)+0,5*OTHK(N2S)/FLOAT(NNZ)+160,0 

DEP05500 

b8* 


S = AMOD(S»360.0) 

DEP05600 

b9* 


S = AMOD(S*360,0) 

DEP05700 

60* 


NYS = 41 

DEP05800 

61* 


NYS$ = 41 

OEP05900 

62* 


DO 22 0=1 I NYS 

OEP06000 

63* 

22 

YY(o) = YSV(J)+S 

DEP06100 

64* 

23 

continue 

DtP06200 

65* 


DO 25 Ns2rNZS 

DEP06300 

66* 

25 

DTHK(N) = DTHK(N)*RAD 

OEP06400 

67* 


DO 30 JslrNYS 

DEP06500 

68* 


DO 30 IslrNXS 

OEP06600 

69* 

30 

0EPN(I*0) = 0.0 

OEP06700 

70* 


ntao = 1 

OEP06800 

71* 


NTAL = 1 

DEP06900 

72* 


IF (NVB .6T, 0) NTaO = 2 

DEP07000 

73* 


IF (NVB ,LE. O.ANP.NNZ ,EQ, 1) nTAL = 2 

OEP07100 

74* 


DO 73 OFSNTALrNTAD 

OEP07200 

75* 


N1AP = NVS 

DEP07300 

76* 


IF (OF ,EQ. 2) NTAP = NVB 

DEP07400 
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77* 


DO 73 II=1*NTAP 

DEP07500 

7a* 


IF (JF .Ew. 2.0R,VS(Ii) .LE. 10,0) GO TO 35 

0EP07600 

79* 


WRITE (6»903) VS(il) 

0EP07700 

ao* 


return 

OEP07800 

ai* 

35 

continue 

DEP07900 

62* 


NTAK = 1 

DEP08000 

63* 


ntar = nnz 

DEP08100 

64* 


IF (NVB ,LE, 0) 60 TO 45 

DEP08200 

65* 


IF tJF ,EQ. 2) GO TO 40 

OEP08300 

66* 


MAR = NTaR-1 

DEP08400 

67* 


GO TO 45 

DEP08500 

68* 

40 

N1AK = NNZ 

DEP08600 

69* 

45 

00 72 KK=NTAKfNTAR 

DEP08700 

90* 


IF (JF ,EQ. 2) GO TO 50 

DEP08800 

91* 


U = 1 

DEP08900 

92* 


S = ( (2(KK+1)-Z(KK) )*.3333333)+Z(KK) 

DEP09000 

93* 


CAUL S6P(S»KK»SiGENKU) »l,IDMY»DMY»OMYrl) 

OEP09100 

94* 


CALL SGP(S»KK»DMY»2»Ii:»UBHKrDMY,2) 

DEP09200 

95* 

C 

determine no. sources in line Source simulation 

OEP09300 

96* 


OhK = ACCUR*SIGENK(1 )*SQBaR*SQRTU,0+VS(II)/UBHK) 

DEP09400 

97* 


IF (OHK .LT. 10,0) OHK = 10,0 

OEP095O0 

9a* 


S = (Z(KK+1)-Z(KK) )/OHK 

OEP09600 

99* 


NXCI = S+1,0 

DEP09700 

100* 


IF (NXCI ,UT, 3) NXCI = 3 

OEP09800 

101* 


IF (NXCI ,GT, 40) NXCI s 40 

DEP 09900 

102* 


IF (JF ,EQ, 1) write (6,909) VS ( II ) ,KK,NXCI 

DEPlOOOO 

103* 


DHK s (Z(KK*1)-2(KK))/FL0AT(NXCI) 

DEPlOlOO 

104* 


STOl = Z(KK) 

DEP10200 

105* 


GO TO 55 

DEP10300 

106* 

50 

NXCI = 1 

DEP10400 

107* 


STOl = 0,0 

DEP10500 



DHK = HB 

DEP10600 

109* 

55 

00 60 IZ=1,NXCI 

DEP10700 

uo* 


STOl = STOI+DHK 

OEP10800 

111* 


ZZL(IZ) = STOl 

DEP10900 

112* 


CALL S6P(2ZL(iZ) ,KK»SIGENK(IZ) ,1 ,IDMY,dMY,DMY,1) 

DEPllOOO 

113* 


CALL SGP(ZZLdZ) ,KK»S1GANK(IZ) ,2, IDMY,DMY»OMY, 1) 

DEPlUOO 

114* 


call S6P(ZZuUZ) ,KK»DMY,2,IZ,UBhK,DMY,2) 

DEP11200 
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U5« 

call S6P(2ZL{I2)»KKrDMY»2,lZ»DMY»DMY»4) 

DEP11300 

lib* 

60 continue 

DEP11400 

lU* 

DO 71 I=1»NXS 

0EP11500 


00 71 JrlfNYS 

OEP11600 


call COORO(N»lrX»Y,XX(I) »YY(J) »ASP»XS»1) 

OEP11700 


IF (N .EOf 9) GO TO 71 

DEP11800 


DO 70 IZ=1»NXCI 

DEP11900 

I'tLZ* 

PHI = ABS(ASP-(THtT+AN0(l2) )) 

DEP12000 

i'^i* 

IF (PHI .OT, 3,1415926536) PHJ = 6,2831853072-PHI 

DEP12100 


Y =XS*SIN(PHI) 

DEP12200 

i'db* 

X =xS*COS(PhI) 

OEP12300 

i'db* 

IF (X ,LE. 0.0) 60 TO 70 

DEP12400 

127* 

DLP = 0,0 

OtPl2500 

126« 

CALl SGp{0MY»KK»DFiY»2rIZ»DMY»X»3) 

DEP12600 

1^9* 

IF (SaGYNK ,L£, 0,0) 60 TO 70 

DEP12700 


DmY = -0.5*(Y/S1GYnK)**2 

OEP12800 

l^l* 

IF (OMY ,LT, -30,0) GO TO 70 

DEP12900 

x^Z* 

D£P = DEP*EXP(OMY) 

OEP13000 

i^Z* 

OfcPN(IiJ) = DEPNa»U)+DEP 

OEP13100 


70 CONTINUE 

DEP13200 

l^b* 

71 CONTINUE 

DEP13300 

l^b* 

72 CONTINUE 

OEP13400 

1^7* 

73 CONTINUE 

OEP13500 

l^b* 

C OuTput GRAVITATIONAL DEPOSITION 

DEP13600 

ii9* 

DO 60 I=1»NXS 

DEP13700 

1^0* 

DO 60 U=1»NYSS 

DEP13800 

im* 

60 CoAMX(l) = AMAXKCUAMXd) ,DEPN(I»U) ) 

DEP 13900 

142* 

MULS = 6 

DEP14000 

*43* 

Z2L(1) = 2(1) 

DEP14100 

A44* 

ZcjSl = Z(l) 

UEP14200 

145* 

2TPl = Z(NZS) 

DEP14300 

A46* 

CALu GENPRT(1,ZUSL»2TPL) 

DEP 14400 

147* 

C 

OEP14500 

l4a* 

DO 90 IzlfNXS 

OEP14600 

149* 

DO 90 JrlfNYS 

DEP14700 

lt>0* 

OtPN(IfJ) = 0,0 

OEP14800 

1S>1* 

90 CUNTINUE 

DEP14900 

lb2* 

RtTURN 

0EP15000 


900 format (23H0*** DATA INPUTS LaYeR »I2fl8H» UBARK AT B0TT0M=»F8.4» IDEPISIOO 

15H» UBARK AT T0P=»FS.4»18h, SIGaK AT B0TT0Mz»F8,5r 15H» SIGAK AT TODEP15200 
2P=,F6,5/17H SIGEK aT BOTTOM=»F8.5r 15Hf SIGEK AT TOP=f F8.5,4Hr Q=»EOEPl5300 
314,8,7H» 0ELX=rEl4,e,7Hr DELY=»e 14,6/7H SIGY0=»F9.4,8Hr SlG2O=,F9,OEPl5400 
44,8h» ALPHA=»F4,X»7H» BETA=fP4.1»19H» THETAK AT B0TT0M=»F6.3f 7 Hi TpEPlSSOO 
5AUK=»F8.3»8Hr TaU 0K=»F8,3/4H Z=fF9,3 DEP15600 

6fl6H, THETAK AT T0P=rF8.3) OEP15700 

901 format (lH0,3(3HVS(»I2»2H)=rF10.5,7H» PERC ( » I2»2H)=»F10.5,2H» )/(lD£Pl5800 

lXr3HVS(»I2»2H)=»F10.5»7H» PERC ( » l2»2H)=fF10*5»5H» VS( , 12»2H)=»F10.0EP15900 
25»7Hr PERC(»I2»2 H)z»F10,5,5H» VS( » I2»2H)s»F 10.5,7H» PERC ( » I2»2H)=»OEP16000 
3Fi0.5r2Hf )) DEP16100 

902 format ( (lX,7(7HGAMMAP(rI2,2H)=,F5.3»2H» ))) 0EP16200 

903 format (1H0,67H****** ERROR *♦♦♦♦* VS HAS EXCEEDED MAXIMUM ALLOWABDEP16300 

ILE value 10, VS=,F9,4) 0EP16400 

905 format (lHl»48X,3bH***** GRAVITATIONAL DEPOSITION *♦*♦♦) OEP16500 

906 format (BHO LAYER ,I2»15H, UBARk AT T0P=»F8,4, 15H, SIGAK AT TOP=»FDEPl6600 

18.5,15H, SIOEK AT TOP=,F8.5f 4H» Q=,E14,8»7H» DELX=fE14,8/6H DELY=»0£P16700 
2Ex4.b»6H» SiGY0=,F9.4,8H» SIGZ0z»F9.4,8H» ALPHA=rF4.1 i 7H» BETA=»F4DEP16800 
3.1»4H» Z=»F9.3/15H THETAK AT T0P=,F8.3) DEP16900 

907 format (IXrlOH Z AT T0P=»F10,4) DEP17000 

908 format (lXrl9hHElGHT OF BURST Hb=»F 10,4»3HVB( r I2»2H)=,F10,5»8H» PEDEP17100 

lRCb(»12,2H)z»Fl0.5,2H, /(1X»3 HVb( »I 2»2H)=rFl0,5,8H» P£RCB(»I2»2H)SOEP17200 
2,F10.5»5H» VB( rl2,2h)=,Fl0.5»8H, P£RCB( »I2»2H)=,F10.5,5H» VB(rl2» OEP17300 
32h)=,Fl0.5»8Hr PERCB( » I2» 2H)=rFl0,5»2H» )) 0EP17400 

909 format (1hO, 10X,4HVS =,F8,4,12H, LAYER NO, ,I2fl8H» NO. OF SOURCESOEP17500 

1 =»16) DEP17600 


END 


DEP17700 
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!♦ SUbKOUTiNt bEuPKT> VEKblOiM 6, REVISION 0 

2 * 

3* SObKOUTiNL bENPRT(K»ZbSL»ZTPL) GPTOOlOO 

CUWiviON /PrtRAMT/ TtSTNOU2), XSKIP ( 15) » NXS» NYS» NZSr NDI »NCI » GPT00200 

5* lNbK,NPTSMMVS»NVB»XX(‘+l) » YY (41 ) . 2 ( 16) »0ELX(15) ,0ELY (15) »Q(l5) » GPT00300 

P* 2UbAKK(16) fSlGAKdo; r5IGEK(l6) fSiGXOdS) »SIGY0(15) rSIGZ0(l5) » 6PT00400 

7* 3AtPriA(20) »BETa( 20) , ZRK , T IMAV » THETAK (lo ) »TAUK»TAU0K»H»XRY»XRZ» GPT00500 

a* 4 XlKY ,XLRZfZ 2L(40) d^MOOdS) r decay »ZLIM»TIM l»LAMBDA»DIdO) »CI dO) r 6PT00600 

9* 5TaST( 05) »JBOT(05) ,bT0P(05) ,VS(2(j) rPERt(20) »ACCUR» VB(20) »P£RCB(20) >GPT00700 

10* 6HofALPhL(0b) »liETL(0 P) »TAUl»TAUOL»ZRL»UBARL (10) »SI6AL(10) »SIGEL(10)GPT00800 

d* 7» rHETAL(lO) »GmMWAP( 20) fNTi , TI (lO ) rNPS, NAMCAS ( 12) GPT00900 

^2* CU(ViwON /PARaMS/ UbMR(20) »S1GAP(20) ,QELTHP(20) »SIG£P(20) iTHETA( 20) fGPTOlOOO 

1DELU(20) >VER» VREF»pEAKD»SiGZ»SlGY»SIGX»SQR2P»L»THf If J,KK»ST01» GPTOHOO 
2SI02fST03,TRDf iLKfKADfNNZdTOPf lB0TfXMST(21) fSIGXNKf JPfPPwRfQPWRf QPT01200 
3MPWRf II,DEP,XbAHX»SOBMRfNxclfLATfSIGYfMKfGAMMA(20) fNCC,NDDfNTTf GPT01300 

16* 4NCCCfNDDDfNTTTfiMSVv2fM0uLS(i5) tKSW(5) f LINESr IMl tMDLSf NWDf GPT01400 

17* 5YSV(41) fYbAKY(4i) rObARNK(41) fbETANK(4i) rALPHNK(4l) »ANG(42) f GPT01500 

16* 6S16cNK( 41) fSlGANK(4l) fOEPN(41f4i) f RNGr AZMt IDATE(2) »ITlME(2) f YTf GPT01600 

19+ 7NYSSfCDAMX(3) GPT01700 

20* C TnlS program CONTROLS PRlNTIN(i OF ALL PROGRAM CALCULATIONS GPT01800 

21* Dimension LxNL(i) ,Ybd) fDPN(4ifi) ,ix(i) gptoi90o 

22* dimension JlINE( 70) fKLINEdO) fNuNIT(8) GPT02000 

23* REAu LAMBDA GPT0210Q 

24* Common /LBLuBL/ J1(9) f J2(4) ,J3(H8) ,J5(6) f J7(3 ) »j 6(16) ,J9(13) fJlOf GPT02200 

25* lJ4(i2) f Jll(2) ,UNlf(lb) GPT02300 

2b* cOUiVALENCE ( TBaRY » LIi>iFJ f ( YBf SIGENK ) f (DPN r BETANK ) f ( IX, XI ) 6PT02400 

27* Common /BnDS/ XRir,XLFT,YbOT,YToP,XPL,YPL GPT02500 

26* COMMON /IlPlTS/ XMAX, XMIN, YMAX , YMIN, XuMl f YBMl ,HTf CHAKF f SCLX, SCLY, GPT02600 

29* IXSIZEirYSiZcl 6PT02700 

>^0* common /PlTlLO/ ISWfXMAXJN,YMAXjN,XCl2E,YClZE GPT02800 

'^1* COMMON /XrXYPT/ YP ( 41 ) ,XP ( 41 ) , A (41 ) ,B ( 41 ) ,C (41 ) ,D (41 ) ,X2 (4l ) f YI (41GPT02900 

32* l),NUM(3)fNC GPT03000 

33* OaTA lSP/lHO/,oSP/lH /, MS/57/ GPT03100 

34* DmTa UNlT/lh ,5rl(PPM)dH ,6H (P,6HPM SEC,lH),6H (Sf6HECONDS,GPT03200 

35* llH),6H (m,oHG/M**3,1H) ,5H (MG ,6HS£C/M* , 3H*3) / 6PT03300 

36* DaTA NUNlT/6H(Mb/M*f 3n*2) ,4H(PN) ,1H f OHMG/M**, 1H2,4H PHflH/ GPT03400 

37* DATA ZEROeS/0,0/ GPT03410 

38* Oi-i = 5 GPT03500 


^9* 


m = 1 

GPT03600 

40* 


IT2 = 7 

GPT03700 

HI* 


lib = 13 

GPT03800 

H2* 


J*t(9) = NUMiT(b) 

GPT03900 

H3* 


uH(iO) = UUNlT(b) 

SPT04000 

hh* 


LrLb4 = 0 

GPT04100 

H5* 


.MCVi = 14 

6PT04200 

H6* 


UCV2 = 7 

GPT04300 

H7* 


NCVb = 2H 

GPT04400 

Ha* 


Ir (KSir.'(l) .Lc. 0) bO TO lO 

GPT0H500 

H9* 


.111 = 19 

GPT04600 

ba* 


Ciu TO 20 

GPT04700 

bi* 

iO 

If- lKS»M2i .Lc. 0) 00 TO 30 

GPT04800 

b2* 


LPL04 = 0 

GPT04900 

b3* 


llr (ISKIP(9; ,cw. 0 ) 00 TO 15 

GPT05000 

b4* 


IF (ISKlfMb) .Nt. i) 00 To 15 

GPT05100 

b5* 


LFLo'^ = 1 

GPT 05200 

b6* 


J4(9) = NuNiT(7) 

GPT05300 

b7* 


jH(iO) = iJU(4lf(d) 

GPT05400 

b8* 

lb 

Continue 

GPT05500 

b9* 


m - 31 

GPT05600 

bO* 

20 

NCVl = 25 

GPT05700 

bl* 


N0V<; = -1 

GPT05800 

b2* 


N 0 V 3 = -1 

GPT05900 

b3* 


UM = 1 

GPT06000 

bH* 

bC 

CONTINUE 

GPT06100 

bb* 


XFRT = Tli''IAV/60,0 

GPT06200 

b6* 


NaS;, = NXb-<i 

6PT06300 

b7* 


ir IISKIPU) ,LE. C) CO TO 170 

6PT06400 

68* 

C 

PKInT OENcRhL GRID CALCULATIONS 

GPT06500 

fa9* 

c 

Gt-T Y IN PROPER INTLRVaL 

GPT06600 

70* 


Uw iOO J=ifi\YSS 

GPT06700 

71* 


Yo(J) = AMOj(YY(J) ,360.0) 

GPT06800 

72* 


Ir (Y8(J) .LT. u.O) Yb(J) = 360,0+Yb(J) 

GPT06900 

73* 

100 

CONI INUE 

GPT07000 

7H* 


Id = 0 

GPT07100 

75* 


00 l60 KS=1,JN 

GPT07200 

76* 


IF (JN ,E0. 1) GO TO 110 

GPT07300 
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77» 


Ih (KS ,EQ. 5) IB = 1 

GPT07400 

78* 


CALL INPTS (KSr IB » NXS » II » NYSS »DEPN , SIGANK) 

6PT07500 

79* 

lie 

Call HEDING(KSW»KS»1»0) 

GPT07600 

ttO» 


call labels (K) 

GPT07700 

81* 


call VRTCLE (KS , JM , K^>W , SIGANK » ISkIP ( 5 ) > NCV t LFL64 ) 

GPT07800 

824c 


N1 = -9 

6PT07900 

83* 

lac 

N1 = Nl+10 

gptobooo 

84* 


N2 = n1+9 

GPT08100 

854c 


IF (iMl- *GT. NKSS) GO TO 160 

GPT08200 

86« 


IF lN2 ,GT. NY5S) = NYSS 

6PT08300 

87* 


LINLS = 80 

GPT08400 

884c 


DO 150 I=1»nXSS 

GPT08500 

894c 


LiNtS = LlNtS+1 

GPT08600 

904c 


IF (LINES .lT, MS) GO TO 140 

GPT08700 

91* 


IF (JM ,Gf. 1) GO TO 125 

GPT08800 

924c 


CALL PRTTTL(NWDrLINES»LINE,0.0»0.0»2BSL»ZTPL) 

GPT08900 

93* 


GO TO 126 

GPT09000 

944c 

12b 

CALL PRTTTL (NWD » LINES » LINE , DECAY r LAMBDA » 2BSL » ZTPL ) 

GPT09100 

95* 

12b 

CONTINUE 

GPT09200 

964c 


IF (KS ,GT. 3) GO TO 130 

GPT09300 

97* 


WRITE (6»900) CDAMX(Kb) » (SIGANK(J) ,J=1,NCV) 

GPT09400 

984c 


LINES = LINeS+2 

GPT09500 

994c 

130 

WRITE (6»90l) (YB(J) f J=N1»N2) 

GPT09600 

lUO* 


WHITE (6»902) (SIGANK ( J) r J=1 »NCV ) 

GPT09700 

1U14C 


LINES - LINeS+4 

GPT09800 

102« 

140 

WHITE (6»90o) XX(I) r (DEPNdf J) »J=N1»N2) 

GPT09900 

1034c 

150 

continue 

GPTIOOOO 

1U44C 


IF (N2 ,LT. NYSS) GO TO 120 

GPTlOlOO 

1U54C 

160 

CONTINUE 

GPT10200 

106* 

170 

continue 

GPT10300 

iU7* 


IF (JM ,GT. 1) GO TO 190 

GPT10400 

1U84C 


DO 180 I=1»nXS 

GPT10500 

1094c 


KOUT = 44CI-3 

GPT10600 

1104C 


Call intout (DEPN rK0UT»NYSS»2» 41, D 

GPT10700 

1114c 

IttO 

continue 

GPT10800 

1124c 

190 

Continue 

GPT10900 

1134c 

C 

pkint and/oh plot centerline calculations 

GPTllOOO 

1144C 


IF (ISKIP(2) .LE. 0) GO TO 480 

GPTillOO 
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U5« 



It) = 0 

GPT11200 

U6« 



DO 340 KS=lrJM 

GPTU300 

117+ 



Ih‘ (JM ,EQ. 1) GO TO 230 

GPT11400 

il6^ 



IK (KS ,EO. 5) IB = 1 

QPT11500 

il9« 



CALL INPTSCKS,IB»NX5»II»NYSS»DEPNfSlGANK) 

GPT11600 



250 

continue 

GPT11700 

i'di* 



DO 340 I=lflNjXS 

GPT11800 

i^2« 



11 = IX(I) 

6PT11900 

123* 



IF ^KS .GT. 1) 60 TO 270 

GPT12000 

124* 



IX(i) = NYSS/2+1 

GPT12100 

125* 



YMAX =0.0 

GPT12200 

126* 

C 


find index at or close TO maxin^um 

GPT12300 

127* 

c 


OH minimum other than zero if LFLG4 = 1 IPHECIP D£P IN PH) 

GPT12400 

l28* 



IF (LFLG4 ,cQ. 1) YMAX = 1.0E8 

GPT12500 

129* 



DO 260 JsImmYSS 

GPT12600 

130* 



IF (LFLG4 .EG. 1) GO TO 155 

GPT12700 

131* 



IF (DEPNdfJ) .LE, YMAX) GO TO 260 

GPT12800 

132* 



60 TO 156 

GPT12900 

133* 


135 

IF (DEPN(irU) .GE. YMaX) GO TO 260 

GPT13000 

134* 



IF (DEPNdrJ) .LE. 0,0) GO TO 260 

GPT13100 

135* 


15b 

CONUNUE 

GPT13200 

136* 



ixd) = J 

GPT13300 

137* 



YMAX = DEPNd.J) 

GPT13400 

138* 


260 

CONTINUE 

GPT13500 

139* 



11 = IX(I) 

GPT13600 

140* 



YPd) = YY(I1) 

GPT13700 

141* 


270 

12 = MAX0(lrIl-3) 

GPT13800 

142* 



13 = MiN0(‘NYS5dl+3) 

GPT13900 

143* 


271 

IF (D£PNdd2) ,GT, 0.0) 60 TO 272 

GPT14000 

144* 



12 = 12-t-l 

GPT14100 

145* 



IF (12 ,LT, ID GO TO 271 

GPT14200 

146* 


272 

IF (DEPNd»l3) ,GT, 0.0) GO TO 273 

GPT14300 

147* 



13 = 13-1 

GPT14400 

148* 



IF (13 .GT. ID GO TO 272 

GPT14500 

149* 


273 

IF (13-12 ,lT. 2) gO to 275 

GPT14600 

130* 



YPL = DEPN(Di2)/DEPN(l»l3) 

GPT14700 

Ibl* 



IF (YPL .LE. 10,0, and. YPL ,GE. 0.1) GO TO 275 

GPT14800 

132* 



IF (DEPNd»l2) ,LT. 0EPN(Id3)) GO TO 274 

GPT14900 
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ib3* 


12 = 12+1 


GPT15000 



IF {12 .GT. ID 12 = U 


GPT15100 

lb5# 


Gw TO 275 


GPT15200 

ib6« 

CM 

13 = 13-1 


GPT15300 

lb7* 


IF (13 ,LT. 11) 13 = a 


GPT15400 

Xb8* 

275 

DPNdrKS) = DuPNCDll) 


6PT15500 

ib9» 


IF (11 .Evi. 12. UR, a .EG. 13) GQ TO 340 


GPT15600 

ibO* 


13 = I3-I2+1 


GPT15700 

ibl* 


IF (13 ,LT. 3) 60 TO 340 


GPT15800 

ib2* 


IF (KS ,GT. l.AND.KS .NE. 4) GO TO 310 


GPT15900 

lb3* 


DU 230 J=lrl3 


GPT16000 

lb4* 

2bO 

XP(j) = Al0G(DEHN(I»I2+J-1) ) 


GPT16100 

IbS* 


call spline (YY (12) rXP»Afl3»CrD»l3»IER) 


GPT16200 

lb&4t 


IF (lER .EQ, 1) GO TO 340 


GPT16300 

ib7* 


IF (KS .GT, 1) 60 TO 510 


GPT16400 

ibS* 


13 = a 


GPT16500 

lb9* 


14 = Xl+1 


GPT16600 

170* 


IF (LFLG4 ,£Q. 1) GO TO 282 


GPT16700 

I7i* 


IF (DEPN(DI4) ,G1, DEPN(DIl-l)) GO TO 

290 

GPT16800 

172* 


IF (DEPN(1»I4) ,LT, OLPN(DIl-l)) GO TO 

285 

GPT16900 

173* 


GO TO 283 


GPT17000 

174* 

282 

IF (DEPN(DI4) .LT, OLPN(lrll-l)) GO TO 

290 

GPT17100 

175* 


IF (DEPN(DI4) .GT. DtPN(DIl-l)) GO TO 

285 

GPT17200 

176* 

283 

CONTINUE 


GPT17300 

177* 


IF (ABS(YY(I3)-YY(13-1) )-ABS(YY(I3)-YY (14) ) ) 290»340»285 

GPT17400 

i78* 

285 

13 = Il-l 


QPT17500 

l79* 


14 = 11 


GPT17600 

lao* 

290 

Ib = I3-I2+1 


GPT17700 

ibi* 


lo = I4-I2+1 


GPT17800 

lb£* 


A(4l) = 0,5*A(I5) 


GPT17900 

lti3* 


B(4i) = (2,0*C(I5)+C(I6)+A(I5)*(-YY(I4)- 

■2,0*YY(I3) ))*, 33333333 

GPT18000 

lb4* 


C(4l) = B(I5)+(YY(l4)*(2.0*(A(Ib)*YY(13) 

-C(I5) )-C(I6) )+YY(I3)*( 

-2.GPT18100 

lb5* 

10*C (I5)-C( 16) +AtIb)*YY( 13) ))*, 18666666 


GPT18200 

lti6* 


YMAX = B(41)*B(41)-4.0*A(41)*C(41) 


GPT16300 

xb7* 


IF (YMAX .LT, O.O) go TO 340 


GPT18400 

laa* 


YNAX = SORT (YMAX) 


GPT18500 

ltt9* 


YPL = 1,0/(2,0*A(41) ) 


GPT18600 

lyo* 


YP(i) = (-B(41 )-YMaX)*YPL 


GPT18700 




XhL = (-B(4i)+YMAX)*YPL 

GPT13800 


it- IABS(YY(I1)-YP(I) ) .6T, ABS ( YY ( I i ) -XPL ) ) Yp(l) = XPL 

GPT18900 

5X0 

lo 11 

6PT19000 


14 = Il+l 

GPT19100 


Ir IYY(I3) ,Lu. Yp ( 1 ) , AND . YP ( I ) .LE. YY(I4)) GO TO 3^0 

GPT19200 


lo = U-1 

6PT19300 


I4 i 11 

6PT19400 

3*:0 

IP iKS ,EO. 4) GO TO j50 

GPTJ9500 


XPL - YP(i)-YY(l3) 

GPT19600 


YpL = YP(X)-YY(14) 

GPT19700 


XPL = XPL^XPL 

GPT19800 


YpL = YPL*YPL 

GPT19900 


XPL = (XPL+AL0G(DcPwa*I4) )-YPL+AL0&(GEPN(1»I3) ) )/(XPL-YPl) 

GPT20000 


IP (XPL ,LT. -bO.O) XPL = -80,0 

GPT20100 


IP (XPL ,GT. 80,0) XPL =80,0 

GPT20200 


DPN(I,KS) = EaPiXPl) 

GPT20300 


bu 10 540 

GPT20400 

530 

15 = I3-I2+X 

GPT20500 


16 = I4-Iii+1 

GPT20600 


IP (YP(I) ,LT, YY(I4)) 60 TO 538 

GPT20700 


DPN(I,KS) = DlPN(1,14) 

GPT20800 


60 TO 340 

GPT20900 

355 

XPL = YP(1)-YY(13) 

GPT21000 


DpN(I,KS) = Xp(i5)+XPL*(E(15)+(YP(I)-YY(I4) )*(2.0+C(i5)+C(16)+A(I56PT21100 


1 ) *XPL ) * , 166fa6b66 ) 

GPT21200 


DPN(I»KS) = EXP(DPW(I»KS) ) 

GPT21300 

340 

C ON fl NOE 

6PT21400 


PKINT maximum ClNTEHLINE CALCULATIONS 

GPT21500 


IP (ISKIP(2) ,EU, 2) 00 TO 420 

GPT21600 


CaLl HEDING(KSW,1,2»1) 

6PT21700 


CmLl labels (K) 

GPT21800 


lines = 80 

GPT21900 


CuAMX(l) = 0,0 

GPT22000 


Ip (LFLG4 ,EQ, 1) cLAmX(I) = 14,0 

6PT22100 


CuAMX(2) - 0,0 

GPT22200 


CuAnX(3> = 0,0 

GPT22300 


Du 550 I=1 »nX8S 

GPT22400 


Uu 550 J=i>5 

GPT22500 





Ir ILFLG4 .tQ. i) GO rO 345 


GPT22600 

d-iO* 


IF lOPNClfO) (Lit v^GAf''! A ( J ) ) GO TO 

350 

GPT22700 



CuAi'/lXCJ) = 0Pi'i(l»wJ 


GPT22800 

cL:>'d* 


ir iJ »E0* i) Go To 346 


6PT22900 



Gu lO 350 


GHT23000 


S^b 

Ir iDPKdfO; ,uui UtO) GO TO 35o 


GPT23100 



Ir lDPN(I»J} ,GT. cGAi'iX(J)) GO lO 

350 

GPT23200 



Cu»Af-'lX(iJ) = oPi'j(ifO) 


6PT23300 

^iil* 


Ir (J .NE. 1) GO I'u GbO 


GPT23400 


b4b 

YPt = AMOo(YP(i) fboU.C) 


GPT23500 

<Li>9* 


ir (YPL .i-T, 0.0) YPL = YPL+3o0,0 


GPT23600 

«;40* 


K 1 Oi*iX z. XX ( 1 ) 


GPT23700 

^•^l* 


AlOiviX = YPL 


GPT23800 

2H2* 

3bO 

Coi'H II^OE 


GPT23900 

243* 


I)- ,GI. 1) bO fu 370 


GPT24000 

C.H4* 


Ir IKSW(I) .GF. 0) ^0 TO 360 


GPT24100 

2H5* 


li 3.1 


GPT24200 

£;‘+b* 


12 = 3b 


GPT24300 

2H7* 


I b M 33 


6PT24400 

248* 


K1 = 1 


GPT24500 

249* 


K(£ = 2 


GPT24600 

2t>0* 


Ir lISMP(9) ,LO. u.OK.ISKlP(b) . 

• i ) GO TO 3b0 

GPT24700 

2bl* 


Ki = 0 


GPT24800 

e;b2» 


K2 = -4 


GPT24900 

tb3* 


Go TO 380 


GPT25000 

2b4* 

3oO 

Ix = 19 


GPT25100 

2bb* 


le: ^ 23 


GPT25200 

tibb* 


13 :: 21 


GPT25300 

tb7* 


Ki = 1 


GPT25400 

2b8* 


Kt i 2 


GPT2bb00 

2b9+ 


Go TO 380 


GPT25600 

«:bO*- 

3/0 

CoUTlNOE 


GPT25700 

2bi» 


U = 1 


GPT2b800 

ib2* 


U = 6 


GPT25900 

£,b3>4‘ 


Ib = 3 


GPT26000 

<ib4* 


Ir (ISKiPlb) ,t4L. 4) GO To 380 


6PT26100 

<s;bb* 


li = iO 


GPT26200 

2bb* 


ii = lb 


GPT26300 



2b9* 
270 + 
27 !♦ 
272» 
273* 
274* 
2/t3’»' 
276» 
277* 
276* 

2ti0* 
2ai* 
cti2* 
2^3* 
M 2b4* 
2b5* 
2bb* 

2b&4< 

2ti9* 

290* 

2yi* 

2y2* 

2^3* 

2y4* 

2y5* 

2y&* 

Z97* 

Z96* 

Z99* 

;>U0* 

oUl^ 

oU2* 

3U3* 

304* 


C 

C 

C 


13 = 12 
3dU CONTINUE 

DO 410 I=A»iMX3S 

IF (DPN(Ifl) ,LE. 0.0) GO TO 41u 
LxNtS = LiNtS+1 
IF (LINES ,uT. MS) OO TO 395 
IF (JM ,G|, 1) GO yO 390 

Call pktttl ( nv.d .lines » li ne , o . o . o . o . zbsl » ztpl ) 

WKITE (6.910) ISP.COAMX(l) . (J3(J) . 0=11. 12) . J4(9) .Wt4(i0) 

WKITE (6»905) (o3(J) .3=11. 13) . (nUNIT(O) . J=K1»K2) 

LiNcS = LlNc.5+6 
6u TO 395 

390 Call PRTTTL(NwD. lines. line. DECA r.UAMBDAfZBSL. ZTPL) 

WKITE (6.904) XbP.COANA(l) f (03(0) .0=1.3) 

WKITE (6.907) 0SP.CUAMX(2) . (03(0) .0=7.8) 

WKITE (6.908) 0SP.COAmX( 3) ,XPKT, (u3(0) .0=13.16) 

WKITE (6.90o) XPRT. (UNIT (3) .0=11 . 12) . (UNIT (0) .0=11 . 13) . (UNIT (0) . 
17.9) . (UNlT(w) .0=11,13) 

LiNES = LINES+8 
395 CONTINUE 

YPL = AM03(YP(I) .obO.O) 

IF (YPL .uT. 0,0) YPL = YPL+360.0 
WKITE (6.909) XA ( I ) . YPL. (UPN { I .0) .0=1 .OM) 

4iO Cv^NTINUE 

IF (KSW(2) ,E0, 0) 00 TO 415 
CuAMX(3) = -5.0 
C3AiMX( 2) = u»0 

IF (LFlG4 .EQ. 1) CUAMa( 2) = -1,0 
(iO TO 416 

415 Ik (K5w(1) ,Ew. 0) GO TO 416 
CDAi'<iX(3) = -6,0 

CuAi>'iX(2) =0,0 

416 CONTINUE 

S^Vt. MAX VAuUcS FOR SUMMARY AT tNO OF RUN 

WRITE (9) (CDAMA(O) .0=1.3) ,RTOMX.ATOMa.ZZL(K) .Z bSL.ZTPL 

Ir- max, pear CONC IS vERY LOW. ABORT THIS CASE 
IF (LFLG4 ,EQ. 1) «0 TO 4ia 


GPT26400 

6PT26500 

GPT26600 

GPT26700 

GPT 268 OO 

GPT26900 

GPT27000 

GPT27100 

GPT27200 

GPT27300 

GPT27400 

GPT27500 

GPT27600 

GPT27700 

GPT27800 

GPT27900 

0=GPT28000 

GPT28100 

GPT28200 

GPT28300 

GPT28400 

GPT28500 

GPT28600 

GPT28700 

GPT 288 OO 

GPT28900 

GPT29000 

6PT29100 

GPT29200 

6PT29300 

GPT29400 

GPT29500 

GPT29600 

GPT29700 

GPT29800 

GPT29900 

GPT30000 

GPT30100 
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j05* 


Xi- (CDAMX(l) ,6 l. 0.001) 60 TO 420 

GPT30200 

jU6* 

411 

WMTE (6»9li) 

GPT30300 

o07* 


GO yo 540 

GPT30400 

JUS* 

4l2 

Ih (CDAMX(l) .Gt. I'i.^) eo TO 4ll 

GPT30500 

JU9* 

420 

Continue 

GPT30600 

olO* 

C 

PLOT maxihum t£NTc.Kl-IN£ CALCULATIONS 

GPT30700 

Jll* 


IT IISKIP(2) .LO, 1) GO TO 480 

GPT30800 

Jl2* 


rii = 0.0 

GPT30900 

JlJ* 


XPL = 0,0 

GPT31000 

jm* 


YPL = 0,0 

6PT31100 

Jl5* 


DO 430 I=1»nXS 

GPT31200 

1 s * 


Xi = XX(I)*SllM(YPa)*HAD) 

GPT31300 

317* 


Y1 = XX(I)*oOS(YP(i)*KAD) 

GPT31400 

Jis* 


YbU) = S0RT( (Xl-XpL)**2+(Yl-YPL)**2)+hT 

GPT31500 

J19* 


HT - Yd(I) 

GPT31600 

JiiO* 


XPL = XI 

GPT31700 

jai* 

430 

YPL = Y1 

GPT31800 

322* 


IP (ISW .NE, 2) GO TO 436 

GPT31900 

j23* 


DO 435 I=1»nXS 

GPT32000 

J24* 


Yu(i) = ALOgIO(YBU) ) 

GPT32100 

J2b* 

43b 

CONTINUE 

GPT32200 

326* 

436 

Continue 

GPT32300 

327* 


Call FSTPlT ( H r RNG » a^M » NAMCAS » IDaTE , IT! ME f CDAMX ( 1 ) » CDAMX ( 2 ) 

#CDAMX(3GPT32400 

J28* 

1) f03(ITl) »J3UT2) ro3(IT3) ,NCVl»NCV2»NCV3f XPRT) 

GPT32500 

J29* 


IT (JM ,GT. 3) JM = 3 

6PT32600 

jJU* 


DO 470 KSslfJM 

GPT32700 

331* 


Call hedin6tkS‘/mks»2,o) 

GPT32800 

332* 


CaLl LABELSiK) 

GPT32900 

333* 


Call VRTCLE ( KS » JM , kSW , sigank » isk ip ( 5 ) » NC V » LFLG4 ) 

GPT33000 

334* 


I^CV = NCV*6 

GPT33100 

335* 


GO TO (440»450»460) »Kb 

GPT33200 

336* 

440 

IF (KS^(l) ,GT, 0,OH.KSW(2) .GT, 0) GO TO 450 

GPT33300 

337* 

C 

Plot maximum CENTEi<LINE CONCENTRATION 

GPT33400 

336* 


IF (NCCC .Ll. 0) Go TO 470 

GPT33500 

J39* 


CmLl LLPLOT(DPN(l»Kb) »YBMNJXSSfHN£»Cl»NCCC»NWD»SlGANk,NCV, 

ZBSLf GPT33600 

340* 

IZ'tPU 

GPT33700 

341* 


NnD = NWD*6 

GPT33800 

342* 


Call LSSOPT(YofDPN{l»KS) »NXSS»NCCC fCl f SIGANK»LINEf NCV ,NWD) 

GPT33900 
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Gu iO 470 

GPT34000 


C 

CcNTERLINl uEHObinON OR DOSAbE' 

GPT34100 



4b0 Ir (NL)DD .Lt. 0) GO TO 47U 

GPT34200 



C aLu LLPLOT ( DPN a » Kb ) r YB » NXSS > L 1 NE » D I » NDDD , Nw'D , SI G ANK , WC V , ZBSL » 

GPT34300 

047* 


IZiPu) 

GPT34400 

b48* 


NwD = i\WQ*b 

GPT34500 

j49* 


CALl LSSOPT ( Yb » uPN ( 1 » kb ) > NXSS , N uDu » UI » SIGANK » LINE > MC V , NWD ) 

GPT34600 

jbO* 


Go TO 470 

GPT34700 

Obl* 

C 

CbNlERLlNt IIiviE-MEAN CONCENTRATION 

GPT34800 

Otiii* 


460 Ih (NTTT ♦Lt. 0) GO TO 470 

GPT34900 

obb« 


• CmLu LLPLuT ( OPN ( 1 r nS ) f YB » NXSS » UNu f T I » NTTT » NWu » S I GANk , NCV , ZBSL t 

GPT35000 

ob4* 


1Z\PU 

GPT35100 

bbb* 


N«D s i\wD*6 

GPT35200 

bbbif 


ChLw LSSOPT (YD*LPN(i»NS) »imXSS,NTTT»TI f S1GANK»LINE#NCV ,NWD) 

GPT35300 

Jb7* 


470 C'jNTINUE 

GPT35400 

bba* 


460 CONTINUE 

GPT35500 

bb9=f 


IP IISKIPU) .ub. 0) WfUTt (9) (ZEROES, J=l, 8) 

GPT35510 

5fc>0» 

C 

Puor isopleths 

GPT35600 

^t>l» 


IP (ISKIP(3) ,Lt. 0) GO TO 540 

GPT35700 

bt>2» 


IP (ISKIP(3) ,EO. i) GO TO 485 

GPT35800 

b63» 


CaLu FSTPuT(H,RN6,A‘^M,NAMCAS,1DaTL, ITIME»CDAMX(1) ,CDAMX(2) »CDAMX(3GPT35900 

oto4# 


1> , Jb(lTl) »UbUT2) ,U3(IT3) , NCVl ,NCV2 »NCV3 , XPRT ) 

GPT36000 

obS* 


46b CoMflNUE 

GPT36100 

bb6* 


Ip (JM ,GT. 3) jM = 3 

GPT36200 

bb7* 


Do b30 KS— IfJM 

GPT36300 

dbH* 


IP (JM .Evji, 1) bO TO 490 

GPT36400 

bb9^ 


Call INPTS ( ^S , 0 , NXS » 1 1 » NYSS , DEPim » SI GAnK ) 

GPT36500 

b70* 


490 CONTINUE 

GPT36600 

b/l» 


CALL HEDlN6(KS/v,KS,3f 0) 

GPT36700 

b72» 


call LAbElS(K) 

GPT36800 

j73» 


CALL VkTClE 1 KS , JM , kSW , KLI NE » I SK iP ( 5 ) » NCV , LFLG4 ) 

GPT36900 

b/4* 


Do *t9b J-x,nWu 

GPT37000 

o7b* 


49b JlINE(J) = LlNE(J) 

GPT37100 

j76+ 


NwD z NWD+6 

6PT37200 

u77* 


Gb 10 (50U,bI0,520) »KS 

6PT37300 

j7ti* 


500 IP (KSw(l) ,GT. 0.bK«NSW(2) .GT, 0) GO TO 510 

GPT37400 

J79+ 


IP (NCC tLE, 0 ) Go TO 530 

GPT37500 

obO* 


C«LL 1 SSOPT ( XX , Y Y , nXS , NCC , C I » JL iNb » NWD , QEPN , NYSS » YBARY » DEPN , 1 1 , KS 

»GPT37600 
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3S1* 

3tt5* 

066* 

3&6>tc 

JS9* 

390 * 

391* 

J92* 

393* 

394* 

395* 

396* 

397* 

398* 

399* 

400* 

401* 

•♦ 02 * 

403* 

404* 

405* 

406 * 

407* 

408* 

409* 

410* 

411* 

412* 

4l3* 


lYTf ISKIP(3) ,KLlNEr(jCV,JM»DECAY»LAMBDArZ8SLfZTPL) QPT37700 

GO TO 530 GPT37800 

510 IF (NDD .lE, 0) GO TO 530 GPT37900 

call ISSOPT(XAf YY»NXS»NDD»Dl»JLlN£fNWD»0£PNfNYSS»YBARY»DEPN»II»KS»GPT38000 
lY I » ISKIP ( 3 ) r KLINE » nCV » JM » DECAY r LAMBDA » ZBSL » ZTPL) GPT38100 

GO TO 530 GPT38200 

520 IF (NTT .lE, 0) GO TO 530 GPT36300 

CALL lSSOPT(XX»YY,NXSfNTT,TIf JLlNE»NWU,UEPN»NYSS»YBARY»OEPNrII,KS»GPT38400 
1YT»ISK'IP(3) ,KLllME»NCVrOM»DECAY»LAMBDAtZBSL»ZTPU GPT38500 

530 continue GPT38600 

540 CONTINUE GPT38700 

return GPT38800 

900 Format (lH0r3aX,F9.3»21H IS the maximum GRID »6a6) GPT38900 

901 format (1H0,6h KANGE»44X»29H- AZIMUTH BEARING (DEGREES) -/lXr8H(MEGPT39000 

ITERS)flO(3X,F7.2»2X)> GPT39100 

902 format (52X,6a6) GPT39200 

903 format (lX»Fa,l»10(F10,3»2X) ) GPT39300 

904 format (Alf 38 a»F9,3»20H IS THE MAXIMUM PEAK»5a6) GPT39400 

905 format (1H0,23X,12HMAXIMUM PEAK/18H RANGE AZIMUTH, 6X»2A6»A2/UGPT39500 

1X,24HBEARING UEP0SITI0N/1X,25H(METERS) (DEGREES) ,A6, AGPT39600 

23) GPT39700 

906 format (1hO,23X,12hMAXIMUM PEAK , 13X , 7HMAXIMUM, 13X , 12HMAXImUM PEAK/GPT39800 

17H range f4X,7HAZIMUTh,6X,l3HCONCENTRATlON,13X,6HDOSAGE»8X»F5.1,17GPT39900 
2H r-UNUTE time-mean, 8X,7HTIME OF, 12X, 13HAVERAGE CLOUD/11X,7HBEARINGGPT40000 
3,51X,13HC0NcENTRATI0N,9X,13HCL0UD PASSAGE, 9X, 13HC0MCENTRATI0N/1X, 1GPT40100 
49H(METERS) (DEGREES) , 5 (2X , 3A6 ,2X ) ) GPT40200 

907 format (Al,44X,F9.3»lbH IS THE MAXIMUM, 5A6) GPT40300 

908 FORMAT (A1»32X,F9,3»20H IS THE MAXIMUM PEAK,F5.1»7H MINUT£»5A6) GPT40400 

909 format (1X,F8,1,2X,F8,3,6X,F10.3,11X,F10.3,13X,F10.3,2(12X,F10,3) )GPT40500 

910 Format (A1,32X,F9.3»20H is the maximum PEAK,4a6,A1,4H in ,A6,A1) GPT40600 

911 format (1H0,59H** MAX, PEAK VALUES ARE INSIGNIFICANT, ABORT THIS GPT40700 

ICASE ♦*) GPT4C800 


END 


GPT40900 
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I* 

2 * 

3« 

4* 

5* 

7* 

&* 

9* 

10* 

XI* 

XZ* 

13* 

14» 

15* 

16* 

17* 

16* 

19* 

20 * 

21 * 

22 * 

23* 

24* 

25* 

26* 

27* 

26* 

29* 

30* 

31* 

32 * 

33* 

34* 

35* 

36* 

37* 

38* 


SUBROUTINE LABELS» VERSION 6, REVISION 0 


SUBROUTINE LABELS(K) LBLOOlOO 

COMNiON /PARAMT/ TESTN0(12), iSKIPdS) »NXS»NYS»NZS»NDI»NCI> LBL00200 

lNBK,NPTS»NVS»NVBf XX(41) »YY(41) »Z(16) »DEL.X(15) fDELY(15) ,Q(l5 ) t LBL00300 

2UbARK(l6) rSlGAKUb) »SIGEK(16) fSlGX0(15) »SIGY0(15) »SIGZ0(15) # LBL00400 

3ALPhA(20) »BETA(20) »2RK»TIMAV»THETAK(16) »TAUK»TAU0K»H»XRY»XRZ» LBL00500 

4XURYfXERZ»ZZU(‘^0)»I^MOD(l5) »DECAYr2LlMi TIMlrLAMBDA»DI (10) ,CI(10)» UBL00600 
5TAST(05) f JBOT(Ob) f jT0P(05) , VS (20) rPERC (20) »ACCUR»VB(20) »PERCB(20 ) iUBL 00700 
6HBrALPHU(05) rBETL(OS) iTAUL»TAUOL»ZRL»UBARL( 10) »Sl6AL(10) »SIGEU(10)LBL00800 


7»THeTAL( 10) ,GAMMAP(20) pNTlrTKlO) » NPS,NAMCAS( 12) 


LBL00900 


common /PARAMS/ UBAR(20) rSIGAP(20) r0ELTHP(20) rSl6EP(20 ) »ThETA( 20) fUBLOlOOO 
1DELU(20) »VER»VREFfpEAKD»SlGZ»SlGY»SIGXrSQR2P»L»TH»I»J»KKfST01» L6L01100 
2ST02 r ST03 » TRD , ILK » RAD » NNZ , ITOP » IBOT » XaST ( 21 ) » SIgXNK » JF » PPWR » QPWR » LBL01200 
3MPWR , 1 1 f DEP » XB ARX » SOBAR » NXC 1 1 LAT » S IGYNK » GAMMA ( 2u ) » NCC » NOD » NTT t U6L0 1300 
4NCCC»NDDD»NTTTrNSW2f MODES (15) »KSW(5) »LINESi IMl »MDLS»NWD» LBL01400 

5YSV(41) »YBARY(41) »UBARNK(41) »BETANK(41) ,ALPHNK(41) »ANG(42 ) $ LBL01500 

6SIGENK(4l)»SlGANK(4l) »DEPN(41»4i),RNGfAZM»IDATE(2) »ITIME(2)»YT» LBL01600 
7NYSS»CDAMX(3) LBL01700 

DIMENSION LINE(I) LBL01800 

common /LBLLBL/ 01(9) ,J2(4) »J3(48) »J5(6) rJ7(3 ) »j8(16) ,J9(13) »J10» LBL01900 
104(12) »0U(2) »UnIT(15) LBL02000 

equivalence (YBARY»LINE) LBL02100 

integer TESTNO LBL02200 

data IBLNK/6H / LBL02300 

C CHANGE following TWO STATEMENTS FOR 7044 LBL02400 

C data IBLK/0000000000060/fl6LP/Oo00000000033/ LBL02500 

data IBLK/0000000000005/»IbLP/0000000000075/- LBL02600 

data 01/54HCALCULATIONS OF MAXIMUM CENTERLINElSOPLETHS /LBL02700 

data 011/7H MINUTE/ LBL02800 

data 02/24H HCL CO C02 AL203/ LBL02900 

data 03/14H CONCENTRATION, 3*1H ,7H D0SAGE»4*1H ,24H TIME-MEAN CONCLBL03000 
1ENTRATI0N»2*2H ,25H GRAVITATIONAL DEPOSITION, IH rl3H CALcULATIONSLBL 03100 
2,3*1H r25ri PRECIPITATION DEPOSITION# IH »22H TIME OF CLOUD PASSAGE»LBL03200 
32*1 h »28H average C«-0UD CONCENTRATION, 1H / LBL03300 

data 010/3H IN/ L6L03400 

data 04/3hPPM,lH ,6HPPM Se,1HC*6HM6/M**,1H3»6hMg SEC#5H/M**3»6HM6/LBL03500 
1M**,1H2,6HSEC0NQ,1HS/ LBL03600 



149 


69 * 

DATa J5/36H at a HEIGHT Op 

meters/ 

LBL03700 

•to* 

Data J7/ibH downwind from a / 


LBL03800 

41* 

OaTa J8/96H STATIC FIRE. 

normal launch. 

SINGLELBL03900 

42« 

1 engine burn. slow burn. 

/ 

EBL04000 

43* 

data J9/78HM00EL WAS USED IN 

THE calculations AND 

the METEORLBL04100 

44# 

iological case is / 


LBL04200 

45* 

DO 10 U=lr60 


LBL04300 

46x< 

10 L1NE(J) = IBLNK 


LBL04400 

47# 

DO 20 U=l»3 


LBL04500 

4B« 

N = KSW(3)+J 


LBL04600 

49* 

20 LINE(J+3) = Ji(N) 


LBL04700 

50* 

30 IF (TESTNO(ll) ,NE. IBLNK) 60 To 40 


LBL04800 

bi« 

N = ISKIP(5) 


LBL04900 

b24> 

L1Ne(8) = J2(N) 


LBL05000 

b3* 

GO TO 50 


LBL05100 

b4* 

40 line ( 8) = TESTNO(ll) 


LBL05200 

b5* 

line (9) = TESTN0U2) 


LBL05300 

b6* 

bO IF (KSW(4) ,Nfc. 12) GO TO 60 


LBL05400 

b7* 

B = TIMaV/60.0 


LBL05500 

be* 

CALU NMBRS(B»LlNEaO).IDUM) 


LBL05600 

b9* 

LIN£(12) = Jll(l) 


LBL05700 

bO* 

LINe(13) = JU(2) 


LBL05800 

61* 

60 DO 70 vl=lf6 


LBL05900 

62* 

N = KSW(4)+J 


LBL06000 

63* 

70 LaNe(J+13) = J3(N) 


LBL06100 

64* 

» IF (KSW(4) ,NE. 24) LINE(20) = JlO 


LBL06200 

65* 

IF (KSW(4) .Eu, 24) 60 TO 100 


LBL06300 

66* 

M = B 


L6L06400 

67* 

IF (KSW{4) ,EO. 30.0R,KSW(4) .EQ. 16) 60 TO 80 

LBL06500 

66* 

M = 0 


LBL06600 

69* 

IF (ISKIP(5) ,EO. 4) M = 4 


LBL06700 

70* 

IF (KSW(4) ,EO. 6) M = M+2 


LBL06800 

71* 

IF lKSW(4) ,EG, 36) M = lO 


LBL06900 

72* 

80 DO 90 J=l>2 


LBL07000 

73* 

N = M+J 


LBL07100 

74* 

90 LINe(J+ 20) = o4(N) 


LBL07200 

75* 

100 OU 110 J=lr6 


LBL07300 

76* 

110 L1NE(J+22) = J5(J) 


LBL07400 
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77i 

78k 

79k 

80k 

ttlK 

82 > 

83^ 

84 ^ 

85 > 

86i 

87 > 

88 > 

89i 

90 . 

91 . 

92 . 

93 . 

94 . 

95 

96 

97 

98 

99 
lOO 
lUl 
102 

103 

104 

105 

106 

107 

108 

109 

110 
111 
112 

113 

114 


call NMbRS( 22L(K) f L^NL (26) , IDUM) 
130 DO 140 J=l»3 
140 LlNfc(J+28) = J7(J) 

DO 150 J=i»4 

150 L1NL'(J+31} = TESTN0(0+6) 

IF (ISKIP(6) ,EO. 5) 00 TO 165 
DO 160 J=l»4 
N = ISKIP^6) *4-4+0 
160 L1N£(0+35) = J8(N) 

Itob 0 = 39 
N^«D = 1 
' 60 TO 190 

166 IF (N .EO. 6) JS = w«S+l 
DO 170 J=1»13 
170 LINE(J+JS) = J9(J) 

B = MDLS 

call NMBRS(B»LINE(sJ5»+2) »IDUM) 

OS z jS+13 
00 180 J=1 k6 

180 LlNt(J+JS) = TESTNOtJ) 

J = JS+6 
NwD = 2 

190 N = 7 

191 N = N-1 

IF (N ,GT. 0) GO TO 200 
N = 6 
0 = J-1 

200 y)S = IABS(6 *(Im-1) ) 

M = 0 

call MSFLD(JS»6»LINE(0> »30»M) 

IF (Ft .EQ. IBLK) 60 TO I9i 
IF (M .EQ. IBLP) 60 TO 220 
N = N+1 

IF (N .LT. 7) GO TO 210 
N = 1 

*J ~ vl+1 

210 JS = IABS(6*(N-1) ) 

call MSFLO(30»6»IBLP»OSrLlNE(O) ) 


LBL07500 

LbL07600 

LBL07700 

LBL07800 

LBL07900 

LbLoaooo 

LBL08100 

LBL08200 

LBL08300 

LBL08400 

L6L08500 

L8L08600 

LBL08700 

LBL06800 

LBL08900 

LBL09000 

L6L09100 

LBL09200 

LBL09300 

LBL09400 

LBL09500 

LBL09600 

LBL09700 

LBL09800 

LBL09900 

LBLIOOOO 

LBLIOIOO 

LBL10200 

LBL10300 

LBL10400 

LBL10500 

LBL10600 

LBL10700 

LBL10800 

LBL10900 

LBLllOOO 

LBLlllOO 

LBH1200 
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il5* 

ZeLO Jb = J 

LBL11300 

ilb* 

60 TO a6b»£»30) »NWU 

LBLU400 

U7» 

£50 NhD = oS 

LBL11500 

il8* 

call PACKS(LINE»NwO) 

LBL11600 


RLToRN 

LBLU700 


END 

L6LU800 



1* 



SUBKOUTiNt packs » VERSION 

5» REVISION 0 


2* 






3^ 



SUBROUTINE PACKS(UlNErNWD) 


PCKOOlOO 

4* 

C 


This subroutine REMOVES EXCESSIVE BLANKS FROM THE TITLE 

AND PACKS PCK00200 

5* 

C 


IT INTO SUCCESSIVE LINES OF 

15 WORDS PER LINE 

PCK00300 

&♦ 



dimension LINEU) 


PCK00400 

7* 



OmTa IBLK/0000000000005/ 


PCK00500 

8* 

cc 


data IBLK/OOOOOOOOOOOOO/ 

IbM 7044 - 

PCK00600 

9* 



NfLS = 0 


PCK00700 

10* 



NK z 0 


PCK00800 

u« 



Ub = 16 


PCK00900 

12* 

C 


Jb IS 15+1 OR 15 WORDS PEK LINE 

PCKOIOOO 

13» 



Ib = 1 


PCKOllOO 

14* 



LST - IBLK 


PCK01200 

15« 



M = 1 


PCK01300 

16* 



N = 0 


PCK01400 

17* 



U = 0 


PCK01500 

18* 


10 

U — J+1 


PCK01600 

19* 



1+ (J «LE. NWu) GO TO 15 


PCK01700 

20« 



NFLu = 1 


PCK01800 

21* 



L = IBLK 


PCK01900 

22« 



N1 = N+l 


PCK02000 

23* 



IF iNl ,GT. 6) 00 TO 80 


PCK02100 

24* 



Ml = h 


PCK02200 

25* 



GO TO 60 


PCK02300 

26* 


15 

K = LINE(U) 


PCK02400 

27* 



I = 0 


PCK 02500 

28* 


20 

I = I+l 


PCK02600 

29* 



IF (I .GT, b) GO TO 10 


PCK02700 

30* 



II = IABS(6*(i-l) ) 


PCK02800 

31* 



Call MSFLuUI»6»Kr30»L) 


PCK02900 

324c 



IF (L .NE, IBlK) GO TO 30 


PCK03000 

33* 



IF (LST .EQ, IBLK) GO TO 20 


PCK03100 

34* 


25 

IlBLK = I 


PCK03200 

35* 



JJBuK = J 


PCK03300 

36* 


30 

N = N+l 


PCK03400 

37* 



NK s NR+1 


PCK03500 

38* 



IF (N ,LT, 7) GO TO 40 


PCK03600 



i9* 

^ 0 * 

<+ 2 * 

43* 

44* 

45* 

46* 

47* 

48* 

49* 

bO* 

bl* 

b2* 

b3* 

b4* 

b5* 

S £>6* 

“ b7* 
b8* 
b9* 
bO* 
bX* 
b2* 
b3* 
b4* 
b£>* 
b6* 
b7* 
be* 

b9* 

70* 

7X* 

72* 

73* 

74* 

75* 

76* 


N = 1 
lb = IB+1 
M = M+1 

40 li = IABS16 *((m-1) ) 

IF (U .NE* IBLK) 60 TO 50 
NNBLK = N 
MiviBLK = M 

50 IF (IB ,LT. Jb) 60 TO 70 

IF (LST .EQ, IBLK.OH.L ,E6, IbU) 60 TO 69 
L = IBUK 
NK = NH-1 

NX = nnblk+x 
M i = mmblk 

IF (NX .LT. 7) 60 TO 60 
Mi = Mi+1 
Ni = X 

60 li = IABS(6*(WX-X) ) 

CALL MSFLD(30»6,LrIi»4lNE(MX)) 

IF (NFL6 »EQ. X) 60 TO 63 
60 TO 64 

63 m = NR+1 

64 CONTINUE 
Ni = NX<fl 

IF (Ni ,LT. 7) 60 TO 60 
IF (NFL6 .Eu* X) 60 TO 80 
Ni = X 
MX Mi+1 

IF (MX ,Lf. M) oO TO bO 
J = wlJBLK 
I s IIBLK 
N = 7 
M s M-1 
LST = IBLK 
Ib s 0 
K = LINE(J) 

60 TO 20 
o9 = X 
LST = IBLK 


PCK03700 

PCK03800 

PCK03900 

PCK04000 

PCK04X00 

PCK04200 

PCK04300 

PCK04400 

PCK04500 

PCK04600 

PCK04700 

PCK04800 

PCK04900 

PCK05000 

PCK05X00 

PCK05200 

PCK05300 

PCK05400 

PCK05500 

PCK05600 

PCK05700 

PCK05800 

PCK05900 

PCK06000 

PCK06X00 

PCK06200 

PCK06300 

PCK06400 

PCK06500 

PCK06600 

PCK06700 

PCK06800 

PCK06900 

PCK07000 

PCK07100 

PCK07200 

PCK07300 

PCK07400 



77* 

IF (L ♦NE, IBUK) GO TO 70 

PCK07500 

78* 

NK z NR*“1 

PCK07600 

79* 

lb = 0 

PCK07700 

b0» 

N = 7 

PCK07800 

ttl* 

M = M-1 

PCK07900 

b2* 

GO TO 20 

PCK08000 

b3* 

70 UST = L 

PCK08100 

bH* 

75 CAUL MSFLu)(30»6#L»II»LINE(|Vi)) 

PCK08200 

b5# 

GO TO 20 

PCK08300 

bfe# 

bO NwD = NR/b 

PCK08400 

b7* 

lo = NWD*b 

PCK08500 

b8* 

IF (IB .Ur, NK) NWO = NWD+1 

PCK08600 

b9* 

RETURN 

PCK08700 

90* 

END 

PCK06800 
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1* 

SUBROUTINE PRTTTLf VERSION 6, REVISION 0 



Z* 

S* 

subroutine prtttl ( nwd » l in£s » l ine » a » b » zb » zt ) 


PRTOOlOO 

4* 

c This subroutine prints the page heading 


PRT00200 

5* 

dimension LiNEU) 


PRT00300 

6* 

data IB/lHl/f JB/IH / 


PRT00400 

7* 

N = IB 


PRT00500 

6« 

lines = 3 


PRT00600 

9* 

Nl= 1 


PRT00700 

10* 

N2 = 15 


PRT00800 

ll* 

10 IF (N2 ,GT. NWD) N2 = NWD 


PRT00900 

IZ* 

write (6»50) N» (LINE(i) »I=N1»N2) 


PRTOIOOO 

IZ* 

lines = LINeS+1 


PRTOllOO 

14* 

N = UB 


PRT01200 

15* 

IF (N2 ,6E# NWD) GO TO 20 


PRT01300 

16* 

N1 = N2*1 


PRT01400 

17* 

N2 = N2<flS 


PRT01500 

16* 

GO TO 10 


PRT01600 

19* 

20 IF (A .GE, 0*0) write (6»80) 


PRT01700 

20* 

lines = LINES+1 


PRT01800 

21* 

IF (A *LE, 0.0) GO TO 30 


PRT01900 

22* 

WRITE (6»60) 


PRT02000 

23* 

lines s HNeS+1 


PRT02100 

24* 

30 IF (B *LE. 0.0) 60 TO 40 


PRT02200 

25* 

WRITE (6»70) 


PRT02300 

26* 

LINES s LINeS+1 


PRT02400 

27* 

40 write (6»90) 2B.ZT 


PRT02500 

26* 

lines = LINeS+1 


PRT02600 

29* 

RETURN 


PRT02700 

30* 

so format (Alrl9Xri5A6) 


PRT02800 

31* 

60 format (42X.45H(D£CAY HAS BEEN INCLUDED IN THE 

CALCULATIONS)) 

PRT02900 

32* 

70 format (33X.64H(PKECIPITATI0N SCAVENGING HAS BEEN INCLUDED IN 

THE PRT03000 

33* 

ICALCULATIONS) ) 


PRT03100 

34* 

60 format ( ) 


PRT03200 

35* 

90 format (34X.37HCALCULATI0NS APPLY TO THE LAYER 

from .F7.2,4H 

TO »FPRT03300 

36* 

18.2.7H METERS) 


PRT03400 

37* 

END 


PRT03500 
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1* 

subroutine VRTCLE» version 6, REVISION 0 


z* 



3* 

subrout I NE VR TCUE ( KS » JM » K5 W » I SToR » I SK 1 P5 » NC V » I FU64 ) 

VRTOOlOO 


dimension KSW(1) ,IST0R(1) 

VRT00200 

5* 

dimension NPH(2) 

VRT00300 

b* 

common /LOLLBL/ J1(9) »sJ2(4) »J3(48) »J516) »U7(3) » j6U6) , J9(l3) » J10» 

VRT00400 

7* 

lU4(i2)»Jll(2) »UNIT(15) 

VRT00500 

8* 

integer unit 

VRT00600 

9* 

data NPH/SH PHflH / 

VRT00700 

10* 

IF (vJM ,6T. 1) 60 TO 20 

VRT00800 

11* 

11 = 31 

VRT00900 

12* 

IF (KSW(2) ,6T, 0) 60 TO 10 

VRTOIOOO 

13* 

11 = 19 

VRTOllOO 

14* 

10 12 = 11+4 

VRT01200 

15* 

13 = 8 

VRT01300 

16* 

60 TO 82 

VRT01400 

17* 

20 60 TO (30»40»50r60»70) fKS 

VRT01500 

18* 

30 11 = 1 

VRT01600 

19* 

12 = 3 

VRT01700 

20* 

60 TO 80 

VRT01800 

21* 

40 11 = 7 

VRT01900 

22* 

12 = 8 

VRT02000 

23* 

13 = 3 

VRT02100 

24* 

60 TO 81 

VRT02200 

25* 

50 11 = 13 

VRT02300 

26* 

12 = 17 

VRT02400 

27* 

60 TO 80 

VRT02500 

28* 

60 11 = 37 

VRT02600 

29* 

12 = 40 

VRT02700 

30* 

13 = 6 

VRT02800 

il* 

GO TO 82 

VRT02900 

32* 

70 11 = 43 

VRT03000 

33* 

12 = 47 

VRT03100 

34* 

80 13 s 0 

VRT03200 

35* 

81 IF (ISKP5 ,E0. 4) J3 = 13+9 

VRT03300 

36* 

82 ISToR(l) = J3(4) 

VRT03400 

37* 

DO 90 Isllfia 

VRT03500 

38* 

90 ISToR(I-Il+2) = J3(I) 

VRT03600 
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'^ 9 * 

NtV = I2-X1+2 

VRT03700 

40* 

IP (JM ,GT. 1) 80 TO no 

VRT03800 


DO lOO I=ir2 

VRT03900 


IF (IFLG4 .NE. 0) GO TO 95 

VRT04000 

43* 

iSToR(NCV+I) = J4(l3+I) 

VRT04100 

44* 

GO TO 100 

VRT04200 

45» 

95 I5T0R(NCV+I) = |MPH(I) 

VRT04300 

46* 

100 CONTINUE 

VRT04400 

47* 

NCV = NCV+2 

VRT04500 

48* 

GO TO 130 

VRT04600 

49* 

110 DO 120 I-l»3 

VRT04700 

£>0« 

120 I5T0R(NCV+I) = UNIT(I3+I) 

VRT04800 

&!♦ 

NCV = NCV+3 

VRT04900 

b2# 

130 CAUL PACKS (ISTOkrNCV) 

VRT05000 

b3* 

RETURN 

VRT05100 

b4* 

END 

VRT05200 


SUBROUTINE NMBRS» VERSION 


1 * 

Z* 

3* 

4* 

5* 

6« 

?♦ 

&♦ 

9# 

10« 

11« 

IZ* 

13* 

14* 

15* 

16* 

17* 

IB* 

19* 

ZO* 

Zl* 

ZZ* 

ii3* 

^4* 

<^5* 

Zb* 

Z7* 

ZB* 

Z9* 

30* 

31* 

32* 

33* 

34* 

35* 

36* 

37* 

38* 


subroutine NMBRS(A»NUM»NC) 
dimension IM(15) »NUM(3) 

NC = 0 

II* (A) 20»10»30 
10 NC = 1 

NUMU) = »0 * 

bu TO 110 
ZO NC = NC+1 

lh(l) = » -* 

30 & = ABS(A) 

K = 6 
M = B 

IR tM .EQ. 0) SO TO 41 
M = AUOGlO(B) 

M = M+1 

MM = b 

DO 40 1=1 »M 

NC = NC+1 

K = MM/10** (M-1) 

MM = MM-K*10**(M-1) 

40 IM(NC) = K+48 
K = 3 

41 M = B 
C = M 

IF (B-C) 50,80»50 
so NC = NC+1 
IM(NC) = ' 

B = B-M 
I = 0 

B = B+l.OE-7 
60 I = I+l 
NC = NC+1 
6 = B*10«0 
M = B 
B = B^M 
IM(NC) = M+48 




REVISION 0 


NMBOOlOO 

NMB00200 

NMB00300 

NMB00400 

NMB00500 

NMB00600 

NMB00700 

NMB00800 

NMB00900 

NMBOIOOO 

NMBOllOO 

NMB01200 

NMB01300 

NMB01400 

NMB 01500 

NMB01600 

NMB01700 

NMB01800 

NMB01900 

NMB02000 

NMB02100 

NM602200 

NMB02300 

NMB02400 

NMB02500 

NMB 026 00 

NMB02700 

NMB02800 

NMB02900 

NMB03000 

NMB03100 

NMB03200 

NMB03300 

NMB03400 

NMB03500 

NMB03600 
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J9* 

IF (I .UT. 6) Go TO 60 

NMB03700 

HO* 

70 IF IIM(NC) .GT. H8.ANL,IM(i’JC) .LT. 58) GO TO 80 

NNiB03800 

HI* 

NC = NC-1 

NMB03900 

H2* 

IF (NC .Lt. Z) 60 TO 80 

NMBOHOOO 

H3* 

GO TO 70 

NMBOHIOO 

HH* 

80 K = 1 

NMB0H200 

H5* 

M = 0 

NMB0H300 

H6* 

QO lOO I=lfNC 

NMBOHHOO 

H7* 

M = M+1 

NMB0H500 

H8* 

IF (M ,LT. 7) GO TO 90 

NMB04600 

H9* 

M = 1 

NMBOH700 

&0* 

K = K+1 

NMB0H800 

bl* 

90 CmLu M5FLD{30f6,I(via)»IABS(6*(M-l))fNUM(K)) 

NMB0H900 

b2* 

100 continue 

NMB05000 

b3* 

110 CONTINUE 

NMB05100 

bH* 

RETURN 

NMB05200 

bb* 

£N0 

NMB05300 
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1* 


SUBK0UTIN6 HEuIiMS» VERSION 5r REVISION 

0 







i* 


Subroutine hEDiNG(KSWrKS»jsw»LSw) 


HEDOOlOO 


c 

SET ALL Parameters nec to building page 

HEADING 

HE000200 

5* 


dimension KSW(1) 


HE000300 

64c 


KSW(3) = 3*jSW-3 


HED00400 

?♦ 


GO TO (10»4o,50»60»70) »KS 


HED00500 

6* 

10 

IF (KSI«(1) ,Eu, O) GO TO 20 


HED00600 

9* 


KSW(4) z 18 


HED00700 

10« 


GO TO 80 


HED00800 

114C 

20 

IF (KSVii(2) ,E0. 0) GO TO 30 


HED00900 

X2« 


KSW(4) r 30 


HEDOIOOO 

13* 


GO TO 60 


HEDOllOO 

14# 

30 

KSW(4) z 0 


HED01200 

15« 


IF (LSI« .EQ, 1) KSw(4) z 24 


HED01300 

I6« 


GO TO 60 


HED01400 

17* 

40 

KSW(4) z 6 


HED01500 

1&* 


Go TO 80 


HED01600 

19* 

50 

KSW(4) z 12 


HED01700 

20« 


GO TO 80 


HED01800 

dl* 

60 

KSW(4) z 36 


HED01900 

dZ* 


GO TO 80 


HED02000 

d2* 

70 

KSW(4) z 42 


HED02100 

dH* 

60 

RtTURN 


HED02200 

db* 


END 


HE002300 


SOBKOUTlNt MbFLDf VERSION 5r REVISION 0 


SOBKOUTINE MSFLudl'I^f iwrd»ji»jwrdj MSFOOXOO 
THIS PROG extracts AN 12 BIT BYTE FROM IWRD STARTJNG AT BlT II ANDMSF00200 
STORES IT IN JWRD starting AT BIT Jl, THE REMAINING BITS OF JWRD MSF00300 
ARE unchanged. U AND J1 ARE COUNTED RIGHT FROM TriE SIGN BIT AND MSF00400 
THE SIGN BIT IS BIT 2ER0. MSF00500 
FLO(Jlf I2»JWRD) = FUD(I1»I2 »IWRd) MSF00600 
RETURN MSF00700 
END MSF00800 
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!♦ 

2 * 

3+ 


SUBhOUTlNe. luPTSf VERSION 5, REVISION 0 
subroutine lNPTS(KS»IBrNX,nrNY,0»T) 

INPOOlOO 



dimension D(4irl) rTd) 

INP00200 

5* 


DU 10 I=1»NX 

INP00300 

6^1 


KUUT = 4*1-4+KS-IB 

INP00400 

?♦ 


CALu INTOUKDrKOUT^NYdf'+ld) 

INP00500 

a* 

10 

CONTINUE 

INP00600 

9 * 


IR (KS .LT. 5) 00 TO 30 

INP00700 

lO* 


DU 20 IslrNX 

INP00800 

!!♦ 


VUUT = 4*1-2 

INP00900 

12* 


CAUc INTOUT(TrKOUT»NY»l»l»l) 

INPOIOOO 

13« 


Do EO J=1»NV 

INPOUOO 

14« 


TNP =0,0 

INP01200 

15* 


IR lT(U) ,LE. O,0.OR.D(I»u) *LE, 0.0) GO TO 20 

INP01300 

16* 


ThP = T(J)/u(ifJ) 

INP01400 

17* 

20 

D(IfJ) = TMp 

INPOISOO 

is* 

30 

RETURN 

INP01600 

19* 


END 

JNP01700 
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!♦ 

2* 

3« 


subroutine intout f VERSION 6, REVISION 0 
SUBROUTINE 1NT0UT(D»I»N»U»IDM»K) 

INTOOlOO 

4* 


dimension D(IDM,1) 

INT00200 

b* 


integer reclth 

INT00300 

6« 


IF (ISP .NE, 0) GO TO 10 

INT00400 

7* 


ISP = 1 

INT00500 

8# 


reclth = 41 

INT00600 

9* 


DEFINE FILE 13(164, RECLTHfU»KOUK) 

INT00700 

10* 

10 

CONTINUE 

INT00800 

11« 


KOUk - I 

INT00900 

12« 

60 

format (1X,6I6) 

INTOIOOO 

13« 


GO TO (20,30),L 

INTOllOO 

14« 

20 

read (13»K0UK) (D(K»J) »J=i»N) 

INT01200 

15« 


GO TO 40 

INT01300 

lb* 

30 

WRITE (13»K0UK) (D(K, J) ,U=1,N) 

INT01400 

17* 

40 

RETURN 

INT01500 

18« 


END 

INT01600 



subroutine break f VERSION 6, REVISION 0 


SUBROUTINE bREAK(K»XOfYO) BRKOOXOO 

common /PARaMT/ TES1N0(12), ISKIPdS) »NXS»NYS»nZS»NDI»NCI» BRK00200 

lNBK,NPTSrNVb»NVb»XX(41) ,YY(41) »2(16) »QELX(15) tDEUYUS) ,Q(l5) » BRK00300 

2UbARK(16) fSlGAKUb) »SIGEK(16) »SI6X0(15) rSIGYO(l5) rSIGZOUS) » BRKQ0400 

3AUPHA(20) »BETA(20) »ZRK»TIMAV»THeTaKU 6) »TAUK»TAOOK»H»XRY»XRZf BRK00500 

4XLRY » XLRZ » ZZU ( 40 ) » IZMOD US ) # DECAY r ZLIM » TIMl » LAMbDA »DI(10)»CIU0)» BRK00600 
5TAST(05) »UBOT(05) »jT0P(05) ,VS(20) »PERC(20) f ACCUR» VB(20) »P£RCB(20) »BRK00700 
6HB»ALPHL(05) »BETL(05) »TAUl»TAUOl»ZRL»UBARL( 10) fSiGALdO) »SIGEL(10)BRK00800 
7 » THeT AL d 0 ) r GAMMAP { 20 ) » NT I , T I (1 0 ) » NPS r NAMC AS (12) BRK0090 0 

common /PARaMS/ UBAR(20) »SIGAP(20) »DELTHP(20) »SIG£P(20) »ThETA(20) »BRK01000 
IDEUU ( 20 ) » VER , VREF t PEAKD r SIGZ » SI gY # SIGX » SQR 2P » L » TH » I » J » KK » STOl » BRKOl 100 

2STOE»ST03»TRD»lLK»RAD»NNZ,lTOPrlBOT»XAST(21)»SlGXNKf JFfPPWR»OPWR» BRK01200 
3MPWR , 1 1 f D£P » XB ARX ♦ SQB AR f NXc I ♦ EAT ♦ SIG YNK » GAMMA ( 20 ) » NCC , NOD , NTT » BRKO 130 0 

4NCCc»NDDD»NTTTfNSW2»M0DLSd5) »KSW(5) »LINESr IMl »MDLS»NWD» BRK01400 

5YSV(41) »YBARY(41) ,UBARNK(41) »BETANK(41) ,AEPHNK(41) »ANG(42 ) f BRK01500 

6SIGENK(41) »SI0ANK(41) fDEPN(41»4l) rRNG»AZM»IDATE(2) f ITIME(2)»YT» BRK01600 

7NYSS»C0AMX(3) BRK01700 

dimension CONd) »D0Sd) f AVCONd) rPASSTMd) »ERFX(1) BRK01800 

EQUIVALENCE (CON»0£PN) » (DOSrDEPN d »2 ) ) f ( AVC0N,D£PN (1 r 3) ) » (PASSTM»DBRK01900 
lEPNd»4) ) t (ERFXfANGdO) ) BRK02000 

real MPWR»L»LAT, lambda BRK02100 

integer TESTNO BRK02200 

♦♦♦ THIS subroutine CALCULATES DOSAGE » CONCENTRATION AND WaSHOUT **BRK02300 

ON A GENERAL GRID WiThIN THE SECTOR DELPHI, BRK02400 

determine location of RECEPTOR RELATIVE TO SOURCE AND WIND BRK02500 

DIRECTION BRK02600 

SUMSX =0,0 BRK02700 

NSMSX = 0 BRK02800 

CALL COORD(N»KK»X»Y»XO»YO»ASP»Xsd) BRK02900 

DOS(J) = 0.0 BRK03000 


CON(J) = 0,0 

IP (NBK ,NE, O.AND.IBOT *LE. KK.AND.KK 
IS = 1 

IF (N ,EQ. 9) GO TO 310 

CALCULATION OF MODELS 
125 CALL SlGMA(X>KKrl) 


KK.AND.KK ,LE, ITOP) GO TO 
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39« 


IF (SIGY) 130»130»126 

40* 

126 

IF (SIGZ tLT* O.O .and. MODLS(KK) 

41* 


LAT = Y/SIGY 

42* 


lat = -0.5*LAT*LAT 

43* 


IF (LAT .LT, -60.0) GO TO 130 

44* 


LAT = EXP (LAT) 

45* 


PEAkD = Q(KK)/(SQR2P*bieY*UBAR(KK: 

46* 


IF (MODLS(Kr) .£Q. 3) GO TO 20 

47* 


PEAKD = P£AKD/(Z(KK+1)-Z(KK) ) 

48* 


60 TO 21 

49* 

20 

PtAKD = PEAKD/ (SQR2P+SIGZ) 

t>0+ 

21 

continue 



VER s 0,0 

t>2« 


VKEF = 1.0 

b3* 


IF (MODLS(KK) .NE. 3) 60 TO 70 

b4* 


VREF = 0.0 

b5* 


TWPol = -0,b/(SlG2*SIGZ) 

b6« 


A = H-ZZL(K) 

b7* 


B = H-Z(KK)-Z(KK)+ZZL(K) 

be* 


C = B*B 

b9* 


C s c*tmpoi 

bO* 


A1 = Z(KK+1)-Z(kK) 

bl* 


IF (C .LT, -30.0) 60 TO 70 

b2* 


D = A*A 

b3* 


0 = d*tmpoi 

b4* 


IF (D .LT. -30.0) GO TO 50 

65* 


VER = EXP(O) 

66* 

50 

VER = VER+6AMMA(1)*£XP(C) 

67* 


C = 1.0 

68* 


D = GAMMA(l) 

69* 


E = D*0 

70* 


Ab s 0.0 

71* 

60 

Ab = AB+2,0 

72* 


TR = AB*Ai 

73* 


TLIM = TR-B 

74* 


TLIM = TLIM*TLIM*TMPQ1 

75* 


IF (TLIM .LT. -10.0) GO TO 70 

76* 


STOl = TR+A 


3) GO TO 130 


BRK03700 

BRK03800 

BKK03900 

BRK04000 

6RK04100 

8RK04200 

BRK04300 

BRK04400 

BRK04500 

BRK04600 

8RK04700 

BRK04800 

6RK04900 

BRK05000 

8RK05100 

BRK05200 

BRK05300 

BRK05400 

BRK05500 

BRK05600 

BRK05700 

BRK05800 

BRK05900 

BRK06000 

BRK06100 

6KK06200 

6RK06300 

BRK06400 

6RK06500 

BRK06600 

BRK06700 

BRK06800 

BRK06900 

BRK07000 

8RK07100 

BRK07200 

BRK07300 

BRK07‘f00 
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77* 


5702 = TR-A 

78* 


ST03 = TR+B 

79* 


VREF = VREF+C*EXP(TLIM)+0*(EXP{ST01*ST01*TMPQ1)+EXP(: 

80* 

lin +E*EXP (ST03*ST03*TMPQ1 ) 

til* 


C = D 

ti2* 


D = E 

ti3» 


E = E*GAMMA(1) 

ti4* 


GO TO 60 

ti5* 

70 

continue 

ti6* 


TMPqI = X/UfaAR(KK) 

87* 


OOS(J) = PEaKD*LAT*(VER+VREF) 

88* 


IF (DECAY ,GT. 0.0) DOS(J) r DOS( J) *EXP (-DECAY*TMP01 

89* 


IF (LANBDA .LE. C.O.OR.TIMl .GE, TMPQl) GO TO 127 

90* 


IF (Z(KK) ,GT, ZLIM) go TO 127 

91* 


AB = EXP (-Lambda* (TNP oi-TiMi) ) 

92* 


DOS(J) = D0S(J)*Ab 

93* 

127 

CONTINUE 

94* 


ANG(l) = UBaR(KK) 

95* 


SUMbX = 5UMSX+516X 

96* 


NSMSX = N5MSX+1 

97* 


IF (SIGX) 129,129.128 

98* 

128 

CONTINUE 

99* 


CUN(J) = u0b(J)*UBAR(KK)/(SQR2P*Sl6X) 

lUO* 

129 

CONTINUE 

lOi* 

130 

IF (IS ,EQ. 1) t.0 TO 310 

102* 


GO TO 140 

103* 

135 

IS = 0 

iU4* 


IF (N ,NE, 9) GO TO IE5 

i05* 

C 

CALCULATION OF THE FULL TRANSITION MODEL, M0DEL4 

1U6* 

140 

DO 200 M=iBOT,lTOP 

107* 


call COORD ( N Hv) , X , Y , XO , YO » ASP » XS , 2 ) 

i08* 


IF (N ,EQ. 9) 60 TO 200 

109* 


CALL 5IGMA(X,M,2) 

110* 


STOl = 1.414214 *SIgZ 

ill* 


TMPOl = l.O/STOl 

112* 


IF (SIGYNK) 200,200rl47 

113* 

147 

IF (SIGZ) 200,200,148 

114* 

148 

LAT = Y/SIGYNK 


BRK07500 
BRK07600 
ST02*ST02=t:TMPOBRK07700 
BRK07800 
SRK07900 
8RKO0OOO 
BRK08100 
BRKoeaoo 
BRK08300 
BKK08400 
BRK08500 
) 8RK08600 

BHK08700 
BRK08800 
BRK08900 
BRK09000 
BRK09100 
BRK09200 
8RK09300 
BRK09400 
BRK09500 
BRK09600 
8RK09700 
BRK09800 
8RK09900 
BRKlOOOO 
BKKIOIOO 
BRK10200 
BRK103Q0 
6RK10400 
BRK10500 
BRK10600 
BRK10700 
BRK10800 
BRK10900 
BRKUOOO 
BRKlllOO 
BHKH200 
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115* 

UAT = -0.b*LAT*LAT 

BKK11300 

lib* 

IF tUAT .LT, -60.0) GO TO £00 

BRK11400 

il7* 

XtiARX = EXPiLhT) 

BRK11500 

ilti* 

A = Z(M+l)-ZZu(i\) 

BRK11600 

il9^ 

B = ZZL(K)-Z((vi) 

8RK11700 

mo* 

C = Z(|Vi+l)+ZZL(K)-Z(IbOT)-Z(lBOT) 

BRK11800 

mi* 

D = Z(lBOT)+ZabOT)-Z(Ni)-ZZU(K) 

BRK11900 

mz* 

EkFaU) = A*TMPG1 

BRK12000 

mi* 

EKFX(2) = B*TmPg1 

BKK12100 

m*^* 

EKFx( 3) = C*TlViP^l 

BRK12200 

mb* 

EKFX(4) = □♦ThPol 

BRK12300 

me* 

ChLl. lS0(Xf4) 

BRK12400 

m7* 

sro*; = ERFX(l)+tRFX(Z)+GA|v|KA(l)*(ERFXi3)+ERFX(4) ) 

6RK12500 

me* 

SI = 0.0 

BRK12600 

1H9* 

So = Z(lTOP+l)-Z(idOT) 

BRK12700 

mo* 

E = 1.0 

BRK12800 

mi* 

F = GAMMA (1) 

BKK12900 

xi2* 

G = F*F 

BKK13000 

m 2 * 

IFL = 0 

8RK13100 

l44* 

ISO SI = Sl+2,0 

BRK13200 

mb* 

S2 = S1*S0 

BRK13300 

me* 

EKFX(3) = (S2+0)+TMPQ1 

8RK13400 

127* 

EkFx(4) = (C-S2)*TMPQ1 

BRK13500 

me* 

IF ilPL .EQ. 0) GO 10 Ibb 

BRK13600 

129* 

IF (ERFX(O) ,GT. 3,0 .and, ERFX{4) ,LT, -3,0) GO TO 185 

BRK13700 

mo* 

105 IFL = 1 

BKK13800 

141* 

EKFX(l) = (S2+B)*Tk|FQl 

6RK13900 

A42* 

EKFX(2) = (A-S2)+TmPQ1 

BRK14000 

143* 

CALu IS0U*4) 

BRK14100 

A44+ 

STOt = ST02+F*(ERFX(1)+ERFX(2) )+E*(ERFX(3)+ERFX(4) ) 

BRK14200 

145* 

EKFX(I) = (S2+A)*TiV|PQi 

BRK14300 

146* 

EKFx( 2) = (b-S2)*TNPQl 

BRK14400 

147* 

EKFX(3) = (S2+C)*TmPQ1 

BHK14500 

148* 

£KFX{4) = (0-S2)+TmPG1 

8KK14600 

x49* 

CALl IS0(1»4) 

BRK14700 

IbO* 

ST02 z ST02+F*(cRFX(1)+ERFX(2) )+G»(ERFX(3)+ERFX(4) ) 

BRK14800 

i.bl4i 

£ = F 

6KK14900 

mu* 

F z 6 

BRK15000 
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ib3* 

lb4* 

it>5* 

ib7# 

i,b8* 

lb9* 

ibO* 

4.bl» 

lb2* 

lb3» 

lb4* 

ib5* 

Ib6« 

ib7* 

lb8* 

ib9* 

iVO* 

X71* 

172* 

173* 

174* 

175* 

a.76^ 

177» 

l78* 

i79* 

IbO* 

Ittl* 

itt2* 

I834t 

ib4* 

i85* 

X86« 

ib7* 

1884^ 

189* 

IVO* 


6 = G+GAMMAU) 

GO TO 150 
185 continue 

ST03 = 1.0/(Z(M+l)-i(M) ) 

XbAKX = EXP(-.54 c(Y/SIGYNK)**2) 

190 TMPQ2 = X/UfaAR(JF) 

SI = (Q(M)*sT03 /(2.04cSQR2P*UbAR(JF)*SIGYNK) )*XBARX*ST02 
IF (DECAY ♦GT. 0.0) SI = S1*EXP (-0ECAY4<TMPQ2) 

IF (LANiBDA ,LE. 0.a.OR,TI^,l.GE.TMPQ2+TAST(ILK-l) ) GO TO 195 
IF (Z(M) .GT. ZlIM) eO TO 195 

51 = S1*ExP(-EANiBDA*(TMPQ2+TAST(ILK'-1)-TIMD) 

195 continue 

IF (SIGXNK) 210,210»211 

210 S2 = 0.0 
GO TO 212 

211 CONTINUE 

52 = (S1*0BaR(JF)/(^»0R2P*SIGXNK)) 

212 continue 

DOS(J) = DOS(sJ)+Sl 
CON(J) = C0w(0)+S2 
SOMSX = SUMsX+SIGXNK 
NSMbX = NSMSX+1 

200 continue 

ANG(l) = oBaR(JF) 

310 continue 
ANG(2) = 0.0 

IF (NSNSX .GT, U) aNG(2) = SUMSX/FLOAT (N5MSX) 

AVCON(O) = 0.0 
PmSSTM(J) = 0.0 

IF (AN6(2) ,Ut. 0,0) GO TO 311 

IF (DOS(J) ,Lt, 0,0) GO To 311 

EKFX(l) =0,0 

IF (ANG(2) ,GT. 0.0) £RFX(i) = aNG(1)*TIMAV/(2.8264271*ANG(2) ) 
CALL IS0(1»1) 

AVCON(U) = (DOS(J)/TIMAV)*eRFX(1) 

PaSsTM(J) = 4.3*ANG(2)/ANG(1) 

311 continue 
R tTuRN 


BRK15100 

BKK15200 

8RK15300 

BRK 15400 

BRK15500 

BRK15600 

BRK15700 

BRK15800 

BRK15900 

BRK16000 

BRK16100 

BKK16200 

BRK16300 

BRK 16400 

BRK16500 

BRK16600 

BRK16700 

BRK16800 

BRK16900 

BRK17000 

BRK17100 

BRK17200 

6RK17300 

BRK17400 

BRK17500 

BRK17600 

BRK17700 

BRK17800 

BRK17900 

BRK18000 

BRK18100 

8RK18200 

BRK18300 

BRK 18400 

BRK18500 

BRK18600 

BRK1S700 

BRK18800 
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191 * 


END 


BRK16900 
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I* 

Z* 

3* 

*+♦ 

5* 

b* 

7* 

b* 

9* 

10« 

u* 

iz* 

13* 

15» 

lb* 

17* 

X8>^ 

19« 

ZO* 

Zl* 

ZZ* 

Z3>ti 

Zt^* 

Z5* 

Zb* 

Z7* 

Zb* 

Z9* 

bO* 

31* 

32* 

33* 

34* 

3b* 

36* 

37* 

36* 


S^BhOUTlNt 


S6P» version b, REVISION C 


C 

C 


SuBKOUTiNt S6P(2H»lM»Sie»lNf lZft'BHK»X»IBb) S6POOXOO 

COMMON /PARaMV TtSTNoaZ), iSNiPaS) »NXS»NYS»NZS»NDI»NCI» S6P00200 

lNDK,NPTSMMVS»NVbfXX(4l) rYY{41) fZ(16) »UELX(15) »DELY(15) »G(i5) » S6P00300 

2Ut>ARK(16) fSlGAKUe*) »SieEKU6) ,SiGXO(lb) ,SIGY0{15) tSIGZOUb) » SGP00400 

3ALPnA(Z0) »BETA(20) ,ZRK,TIiViAVrThETAK(l6) f TAUK»TA00K»H»XRY»XRZ» S6P00500 

4XuRy»XLRZ»Z 2L(40) .14M0Dab) »DECaY » ZLIM, TIM fLAMbOA rDI ( 10 ) » Cl UO ) » SGP00600 
5TAST(0b) »oBOT(Ob) » JTOP (Ob) , VS(20) »P£RC(2C) »ACCUR»VB(20) »PE«^CB(20) »SGP00700 
6Hb»ALPHL(05) »bETU(0S>) f TAULfTAUOL»ZRL»UBARL(10) »SlbAL(iO) »SlGEt (10)SGP00800 
7f THtTAU(10) »GANi|vlAP(ZO) r NTi , TI ( lO ) » NPS» NAMCAS ( 12 ) SGP00900 

common /PaRaMS/ UbA^UO) »SIGAP(20) »DELTHP(20) »SiGtP(20) »THETA(20) »SGP01000 
1UELU(2C) »VER,VREF»PEAKD»SI6Z»SI6Y»SIGX,SGR2P»L»TH»I»J,KK»ST01» S6P01100 

2ST02fST03rTKD» lLK»RAD»NNZrlTOH»lBGT»XAST (21 ) » SIGXNK » JF »PPWR »QPWR » SGP01200 
3MHWR ,11, DEP , XbARX , SOBAR » NXc I » LAT » SIGYNK t GAMMA (20 ) » NCC » NOD» NTT , SGP01300 

4NoCC»NQDD»NtTT,nSW2»MODLS(15) ,KsW( 5) »LINES, IMl ,MDLS,NwDf SGP01400 

5YSV(41) ,YbAKY(4i) ,UfclARNK(41) ,6ETANK(41) ,ALPHNK(4l) »ANG(42) » SGPOlbOO 

6SiGENK(41) »SI6ANK(41) »DEPN(41,4i) ,RNG»AZM,IDATE(2) ,ITIME(2) »YT, SGP01600 

7NYSs»C0AMX(3) SGP01700 

dimension DTHK(21) SGP01800 

EOUiVAEENCE (uThKfXASl) SGP01900 

integer TESTNO SGP02000 

REAu MPWRfL, LAMBDA SGP02100 

subroutine SGP calculates SIGeNK and SIGANK with or without SGP02200 

DESTRUCT in the layer. SGP02300 

GO TO (4f44,64,D8) , IBB SGP02400 

+ S = 0,0 SGP02500 

MN = N-1 SGP02600 

HhNr = ZH SGP02700 

HHRk 1.0 SGP02800 

IF (N ,EQ. i> GO TO 5 S6P02900 

HHRk = ZH SGP03000 

HHNk = Z(N+1) SGP03100 

5 SG3 = SIGEK(I) SGP03200 

IF (IN ,EO. 2) SG3 = SIGAP(l) S&P03300 

IF (N .LE. 2) GO TO 30 SGP03400 

DO 25 M=2,Mn SGP03500 

IF (IN ,EO, 2) GO TO 10 SGP03600 
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i9* 


Sbl = SIGEK(M+1) 

SGP03700 

HO* 


Sb2 = SI6£K(M) 

SGP03600 

41* 


GO TO 20 

SGP03900 

42* 

10 

SGI = SIGAP(M+1) 

SGP04000 

43* 


SG2 = SIGAP(M) 

SGP04100 

44* 

20 

S = 5+(SGl+S62)*(2(M+l)-2(M) )*0,5 

SGP04200 

45* 

25 

continue 

SGP04300 

46* 

30 

IF (IN ,EQ. 2) GO TO 35 

SGP04400 

47* 


SGI = SIGEK(N+1) 

SGP04500 

4B* 


SG2 s SIGEK(N) 

SGP04600 

49* 


PWR = QPWK 

S6P04700 

bo* 


GO TO 40 

SGP04e00 

bl* 

35 

SGI = SIGAP(N+1) 

S6P04900 

be* 


SG2 = SIGAP(N) 

S6P05000 

b3* 


PwR = MPWR 

SGP05100 

b4* 

40 

IF (N .EQ. 1) GO TO 42 

SGP05200 

b5* 


S z S+(ZH-Z(N))*(((SG1-SG2)/(2(N+1)-Z(N)))*(ZH-Z(N))+SG2)*0.5 

S6P05300 

b6* 

42 

SIG Z (S+RBll(SG3rPWR,HHNK,ZRK) )*RAU/HHRK 

SGP05400 

b7* 


RETURN 

SGP05500 

be* 

C 

ENTRY UBARS(ZH»N»IZ»UEHK) 

SGP05600 

b9* 

C 

SUBROUTINE UBARS CaUUUATeS UBARNK# X NK» Y NK» CAP THETA (ANG) 

SGP05700 

bO* 

44 

XBARX z 0.0 

SGP05600 

bl* 


YBARY(IZ) z 0,0 

SGP05900 

b2* 


VV = VS(II) 

SGPObOOO 

b3* 


PWR z PPWR 

SGP06100 

b4* 


IF (JF ,EQ. 2) VV z Vb(II) 

SGP06200 

b5* 


IF (N ,EQ. 1) 60 TO 50 

SGP06300 

bb* 


MN = N-l 

S6P06400 

b7* 


DO 45 M=1»MN 

SGP06500 

be* 


S z DTHK(M+1)-DTHK(M) 

SGPObbOO 

b9* 


IF (S) 46»45»46 

SGP06700 

70* 

4b 

CONTINUE 

SGP06800 

71* 


SI = SIN(DThK(M+ 1) )-SlN(DTHK(M) ) 

SGP06900 

72* 


S2 = C0S(UThK(M+1) )-COS(DTHK(M) ) 

SGP07000 

73* 


S z UBAR{M)*(Z(M+1)-Z(M))/(VV*S) 

SGP07100 

74* 


X6ARX z XBAKX+(S1*S) 

SGP07200 

75* 


YbARY(IZ) = YbARY(lZ)+(S2*(-S)) 

SGP07300 

7b* 

45 

continue 

SGP07400 


77* 


50 

Tl^iPQl = 1,0/{Z(N+1)-21N)) 

S6P07500 

78* 



S = ((DTHK(N+1)-DTHK(N) )*TMPQ1)*(2H-Z(N) )+DTHK(N) 

SGP07600 

79 * 



SI = SIN(S)-S1N(DThK(N) ) 

S6P07700 

80* 



S2 = C0S(S)-C0S(DTHK(N)) 

SGP078G0 

81* 



IF (N .EQ. 1) GO TO 52 

SGP07900 

62* 



U6HK = ( (OBaRK (N+1 ) -UBARK (N) ) *TmPG1 ) *0 . 5* (ZH-Z (N) ) + ( 0, 5*UBARK (N) ) 

SGP08000 

83* 



GO TO 54 

SGPOBIOO 

84* 


52 

UBHK = RBlHUBARK(l) »PWR»ZH»ZRK) 

SGP08200 

85* 


54 

continue 

SGP08300 

86* 



S = DTHK(N+1)-DTHK{N) 

S6P08400 

87* 



IF (S) 53 » 55 » 53 

SGP08500 

88* 


53 

S = UBHK/(VV*S*TMPq1) 

S6P08600 

89* 



X6ARX = XBARX+(S1*S) 

SGP 08700 

90* 



YbARY(IZ) = YBARY(lZ)+(S2*(-S) ) 

SGP08800 

91* 


55 

CONTINUE 

SGP08900 

92* 



IF (XBARX) 57»56»57 

SGP09000 

93* 


56 

IF (YBARY(IZ)) 57,58»57 

SGP09100 

94* 


57 

AnG(IZ) = ATAN2(YBaRY(IZ) »XBARX) 

SGP09200 

95* 



60 TO 60 

S6P09300 

96* 


56 

ANG(IZ) = 0.0 

SGP09400 

97* 


59 

UBARNK(IZ) = UBhK 

SGP09500 

98* 



SuBaR - 0,0 

SGP09600 

99* 



GO TO 62 

SGP09700 

ioo* 


60 

IF (XBARX) 61 » 59 » 61 

SGP09800 

101* 


61 

SGBAR = SQRT{X6ARX*XBARX+YBARY(iZ)*YBARY(IZ)) 

SGP09900 

102* 



UBARNK(IZ) = SQbAR+VV/ZH 

SGPlOOOO 

103* 


62 

CONTINUE 

S6P10100 

104* 



RETURN 

SGP10200 

105* 

C 


ENTRY DEPSO(X»NrIZ) 

SGP10300 

106* 

C 


SUBROUTINE UEPSO CAUCUUATeS ALL OF THE DEPOSITION EQUATION EXCEPT 

SGP10400 

107* 

c 


THE lateral term 

SGP10500 

106* 


64 

ZF = ZZL(IZ) 

SGP10600 

109* 



VV = VS(II) 

SGP10700 

110* 



GAMmB = GAMMA(II) 

S6P10600 

111* 



XXX s X 

SGP10900 

112* 



perk 5 PERC(U) 

S6P11000 

113* 



IF (OF .EQ. 1) 60 TO 165 

S6P11100 

114* 



ZF = Hb 

S6P11200 
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U5« 


VV = VB(II) 

SGP11300 



XXX = X+(SI6Z0(N)/SI6£MK(I2) )**(!, O/BETANKdZ)) 

S6P11400 

il7» 


PERK = PEKCbUl) 

S6P11500 

118* 

165 

xknk = 0.0 

S6P11600 

U9« 


IF (GAMMB .6E. 1.0) 60 TO 69 

SGP11700 

VdO* 


SI = 1,0/(SIGENK(1Z)*XXX**BETaNK(IZ)) 

SGP11800 

I'dl* 


S2 s VV*XXX/U6ARNK(IZ) 

S6P11900 

Idd* 


S3 = -0.5*Sl*Sl 

SGP12000 

id3* 


S4 = BETANK(U)*(S2-ZF)-S2 

SGP12100 

iS4« 


S2 = 52-ZF 

SGP12200 

iiiS* 


B = 1,0 

SGP12300 

I’db* 


XKNk = -S4*tXP(S2*S2*S3) 

SGP12400 

127* 


A = 0.0 

SGP12500 

128« 

6b 

A = A+2,0 

S6P12600 

i29* 


S6 = A*Z(N+1) 

SGP12700 

i^O* 


S6 : Sb*>S2 

SGP12800 



S7 = S5+S2 

SGP12900 



S7 = S7*S7*S3 

SGP13000 

i^3« 


S6 z S6*S6*S3 

SGP13100 

134* 


IF (A .LE, 2.0) GO TO 66 

SGP13200 

135* 


IF (S6 ,UT. -10,0. AND. S7 ,LT. -10,0) GO TO 67 

SGP13300 

136* 

66 

S5 = S5*B£TaNk(1Z) 

SGP13400 

l37* 


XKNK = XKNK+B*( {S5+S4)*EXP(S7)+gAMMB*(S5-S4)*EXP(S6)) 

SGP13500 

136* 


IF (GAMMB ,LE. 0,0) 60 TO 67 

SGP13600 

139* 


B = B*GAMMB 

S6P13700 

140* 


GO TO 65 

SGP13800 

141* 

67 

continue 

SGP13900 

142* 


XY = (Si6Y0(N)/SIGANK(IZ) )♦*(!, 0/ALPHNK(IZ)) 

SGP14000 

143* 


SIGYNK = SORT ( ( SIGANK ( 12 ) ♦ ( X+XY ) **ALPHNK ( IZ ) ) **2+ (SIGENK ( IZ ) *XXX**SGP14100 

144* 

IBETaNK { IZ) *YBARY ( IZ) /ZF ) **2 ) 

S6P14200 

145* 


IF (SIGYNK ,UE, 0,0) GO TO 69 

S6P14300 

146* 


DEP = Q (N) *PERK* ( 1 , 0-GAMMb ) *S1*XKNK/ ( 6 , 2831853*SIGYNK*FL0aT (NXCI ) *S6P14400 

147* 

IXXX) 

SGP14500 

148* 

69 

CONTINUE 

SGP14600 

149* 


RETURN 

SGP14700 

IbO* 

C 

entry BETAK(2HrN»IZ) 

SGP14800 

Ibl* 

C 

subroutine betak calculates beta nk and alpha nk 

SGP14900 

lb2* 

66 

SI = 0,0 

SGP15000 


174 


lb3* 

S2 = 0.0 

SGP15100 

ib4* 

IF (N .EQ. i) GO To 90 

S6PI5200 

ib5* 

Mix = N-1 

SGP15300 

lb64c 

Do 70 M=1 »Mn 

SGP15400 

lb7* 

SI = S1+BETa(K)*(Z(M+1)-Z(M) ) 

SGP15500 

ib8* 

S2 = S2+ALPhA(M)’MZ(M+i)-Z(M) ) 

SGP15600 

ib9* 

70 CONTINUE 

SGP15700 

ibO* 

TmPoI = 1.0/Zh 

SGPI5800 

ibl + 

TMPo2 - Zh-Z(N) 

SGP15900 

162* 

BETaNK(I2) = (S1+8ETA(N)*TMPQ2)*TMPQ1 

StiPlbOOO 

lb3+ 

ALPhNK(IZ) = iS2+ALPHa(N)*TMPQ2)*TMPQ1 

SGP16100 

xb4* 

GO TO 95 

SGP16200 

lb5* 

90 B£TaNK(I2) = BETA(N) 

S6P16300 

JLb64< 

ALPhNK(IZ) = ALPHA (N) 

SGP16400 

ib7* 

9b CONTINUE 

SGP16500 

lb8^ 

RLTUKN 

SGP16600 

lb9* 

END 

SGP1G700 



SUBKOUTINE WaShT, VEKSIOn 6, REVISION 0 


SUBkOUTINE WASHI 

COMMON /PARaMI/ TtSrN0(l2), ISKIP ( 15) » NXS»HYS»NZS»NDI »NCI » 

lNt)K,NPTS»WVS»NVDrXX(41) ,YY(41) fZ(16) »DEUX(15) ,UELY(ib) ,Q(l6)» 
2UBAKKU6) rSlGAKUo) fSlGEK(l6) rSlGX0(15) ,SIGY0(15) »SIGZ0(15) » 
3ALPhA(20) »BETA(20) , ZKK r TIMAV » THETAK (It. ) »TAUK»TAuOK»h»XRYf XRZ» 
4XuRYfXuRZrZZL(40) rlZM00(15) f DECAY » ZLli-i» TIMl ,LAMbDA»DI (10 ) »CI ( 10 ) » 
5TaST(05) f JBOT(Ob) r oTOP ( 05) , VS (20 ) »P£RC (20 ) » ACCUR» VB (20 ) fPERCB ( 20 ) ( 
6Hb»ALPhL(05) ,SETL(Ci>) »TAULfTAUOL»ZRL»UBARL(10) fblGALdO) »SIG£L(10: 
7»ThETAU(10) ,GaM(v,AP(20) »NTl,TI (lO) fNPS»NAMCA5(12) 
common /PARAMS/ UBAH ( 2 0 ) » si gap ( 2 0 ) , DELTHP ( 2 0 ) r Si 6£P ( 20 ) f THETA ( 20 ) i 
IDtEo ( 20 ) » VEK » VREF » P£A^D » S 1 GZ » SIgY , SIGX , SQR2P » L f TH r I » J r KK » STOl » 
2ST02»ST03»TKD»lLKrKAD»NNZ,lT0P»lB0T»XA5T(21) »SlGXNKrJFfPPWR»QPWR» 
SMPWRf II»D£PrXbARXfSGbAR»NXCI»LAT»SIGYNK,GAMMA(20) »NCC»NDDfNTTf 
4NCCC f NGDD r NT TT t NSrt 2 » MODES ( 1 5 ) r KSW ( 5 ) » L I NES » IMl » MDES » NWD » 

5YSV(41) ,YfaAKY(41) ^ UbARNK ( 41 ) »bETANK (41 ) » ALPHNK (4l ) » ANG (42 ) t 
6S1GeNK( 41) »bl6AlMK(4l> »D£PN(41»4l) ,RNG»AZM»1DATE(2) »ITIME(2) »YT» 
7NYSb»CDAMX(b) 
dimension WAShOU(41»l) 

EUUiVALENCE (OEPNr V<AShOU) 

EwUiVAEENCE (lSw6»SlGENK) , (A»SI gENK( 2) ) , (BrSlGENK(3) ) r (C»SIGENK(4: 
1) » (U»SIGENK{5) ) , (E,SIb£NK(6) ) f (G»S1GENK(7) ) 
real MPWR»L»LAMbDA 
IimTEGER T£STN0 

This subroutine CmlCULATES PRECIPITATICN DEPOSITION - MODEL 5 

♦ For output in V,G/M*»2 (i(KK) IS IN UNITS OF MILLIGKAMS. 

♦ FOR OUTPUT IN Ph OF TIME DEPENDENT DEPOSITION Q(KK) IS IN UNITS 
OF G(KK)= ( (i(toRAM5)*U/(RATE IN/HR) ) ♦ (1/25,4)»(1/M0LE WT.)» 

(I/DUKaHON HRS) ) Then QEP in PH = -LOGIO(WASHOU) . 

♦ FOR OUTPUT IN Ph OF MAXIMUM DtP AT EACH POINT Q(KK) IS IN UNITS 
OF Q(KK)= ( 0 (GRaM5)»(1/(RATe IN/HR) )*(1/25.4)*(1/M0LE WT.) ) 

THEN UEP IN Ph = -.LOGIO(WAShOU) WhERE DEP IN PH IS > 0 AND 
< OR = 14. 

ALSO LAMBDA CAN BE CALCULATED BY - 

lambda = b.SE-5*( (RATE IN/HK)*(2.54 CM/IN)*(10 MMi/CM) )**#567 
= 5,2E-4*(RaTE MM/hR)**.567 IN UNITS OF (1/SEC) 

C = 1.0 



39* 


D = 1,0 

40* 


E = 1.0 

41* 


call COORU(N»KK»XrY»XX(I) rYY(u) ,ASPrXS»l) 

42* 


IF (Nbk.nl.o.anu.ibot.le.kk.and.kk.le.itop) go to 

43+ 


IF (N ,EQ» 9) GO TO 70 

44+ 


10 CALL SlGMA(X»KKrl) 

45* 


A = UBAR(KK) 

46* 


B = SIGY 

47* 


G = TIMI 

46* 


GO TO 30 

49* 


20 IF tN ,NE, 9) GO TO 10 

bO* 


call COORU(N»KK»X,y»XX(I) »YY(J) ,ASP»XS»2) 

bl* 


IF (N .EO, 9) GO TO 70 

b2* 


call 51GMA(X»KK»2) 

b3* 


A = UBAR(UF) 

b4* 


B = SIGYNK 

b5* 


6 = TIWI-TAST(ILK-I) 

b6* 


SIGX = SiGXiMK 

b7* 


30 IF (ISKIP14) ,Nt. 0) GO TO 35 

bS* 


IF (X/A ,LT, G) go to 70 

b9* 


35 continue 

bO* 


IF (B ,LE. 0,0) GO TO 70 

fal* 


IF (G ,LT. (X-2,lb*SlGX)/A) GO TO 40 

b2* 


IF IISKIP(4) ,Eoi, 1) GO TO 40 

63* 


L = AM0D(YY(J) »360.0) 

64* 


IF (E ,LT. 0,0) E = 360, 0+E 

65* 


write (6»60) XX(I),E 

66* 


40 CONTINUE 

67* 


bO E = Y/B 

66* 


E = «-0,5*t*E 

69* 


IF (E »LT» *60»0) GO to 70 

70* 


E = EXP(E) 

71* 


IF (ISKIP(4) ,EO. 0) GO TO 55 

/2* 

C 

MAXlMUf^. OEP 

73* 


C = £XP(-LAMBjA*2.lb*SIGX/A) 

74* 

C 

IF OUTPUT IN PH 

7b* 


IF (ISKIP(9) ,Nt. 0) C = C*837.209302*A/SIGX 

76* 

c 

837,2093O2*A/blGX=l/OURATlON=3600*UBAR/(4,3*SIGX) 


WSH03700 

WSH03800 

V«SH03900 

WSH04000 

WbH04100 

WSH04200 

WSH04300 

WSH04400 

WSHQ4500 

WSH04600 

WSH04700 

WSH04800 

WSH04900 

WSH05000 

WSH05100 

WSH05200 

WSH05300 

WSH05400 

WSH05500 

WSH05600 

WSH05700 

WSH05800 

WSH05900 

WSH06000 

WSH06100 

W8H06200 

WSH06300 

WSH06400 

WSH06500 

WbH0660Q 

WSH06700 

WSH06800 

WSH06900 

WSH07000 

WSH07100 

WSH07200 

WSH07300 

WSH07400 
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11 * 

IB* 

19 * 

BO* 

til* 

BZ* 

B2* 

BH* 

as# 


C 


GO TO 60 
55 CONTINUE 

time oependent OEP 

C = £XP(^UAMBDA#(X/A*6) ) 

60 WASHOU(IfJ) = wASH0U(I»sJ) + (tANB0A*Q(KK)/(SQR2P*A*b) )#C#E 
70 return , ^ 

aO format (IhOrSbH ♦♦♦ PRECIPITATION DEPOSITION AT XX=»F10.3,5H» 

iFio,3»26H May be over estimated ***/) 

END 


WSH07500 

WSH07600 

WSH07700 

V<SH07800 

WSH07900 

WSH08000 

YY=iWSH08l00 

WSH08200 

WSH08300 



SOBKOUTINt. COOKDf VERSION 5» REVISION 0 


subroutine COORU(NrM»X,Y»XO»Yo»ASP.,XSf ICK) CRDOOlOO 

common /PARAMT/ TESTN0U2), ISKIP ( 15) » NXS» iNYS»N2SfNDI »NCI » CRD00200 

INBK^NPTS^NVSfNVb^XXi^l) »YY(41) ,Z(16) »uELX{15) ,DELY(15) ,Q(X5 ) , CRD00300 

2UbARK(16) fSiGAKUB) »SieEK(l6) »Si6X0(15) »SIGY0(15) *SIG20(15) » CRD00400 

3ALPriAU0) »BeTA(20) ,2RR,TIMAV»THeTAK(16) »TaUK »TAU 0K »h» XRY » XRZ , CRD00500 

4XURYfXLRZ»ZZU(40) ,I2M0D(15) »DECAYfZLlM,TIMl rUAMBDAtDI CIO) rCI (10) » CRD00600 
5TASU05) rOBOT(Oo) »uTOP(Ob) rVS(2o) »P£RC(20) f ACCUR»VB(20) »PeRCB( 20) »CRD00700 
6Hb»ALPHL(05; »BETL(0t>) fTAUL,TAU0L»ZRL»UBARL(10) ,SIGAL(10) fSlSELClOCRDOOBOO 
AtHeTAU(IO) ,GAMMAP(iiO) »NTi,TI (10) » NPS rNAMCAS ( 12 ) CRD00900 

COMMON /PARAMS/ UBAR (20 ) » SIGAP (20 ) ,OELTHP (20 ) »SIGEP (20 ) » ThETa ( 20 ) »CRD01000 
1DELU(20) »VEK»VREF»PEARUrSlGZ»SlGY»SIGX,SQR2P»L»TH,I»U,KK»ST01» CRDOllOO 
2ST02 f ST03 f TRD » ILK » RAD » NNZ , ITOP , IBOT » XAST ( 21 ) » SIGXNK » JF » PPwR » QPWR » CRDO 1200 
3MPWKrII,DEP»XBAKX»SQBAR»NXCl»LAT»SIGYNK>GAMMA(20) »NCCfNOD»NTT» CR001300 
4NCCCfNUDD»NTTl »NSW2» WOOLS (15) »KbW(5) »LlN£S» IMl »MDLS»NWD» CRD01400 

5YSV(41) .YbARY(4l) ,UBARNK(41) »BETANK(41) ,ALPhNK(4l) »ANG(42) » CRD01500 

6S1GeNK( 41) »SIGANK(41) » DEPN ( 41 » 4i ) ,RNG , aZM » IDATE (2 ) » I T IME (2 ) » YT » CRD01600 

7NYSSfCDAMX(3) CRD01700 

IimTeGER TcSTNO CRDOISOO 

RlAl MPWR»L»LAMBDA CRD01900 

♦♦♦♦♦THIS SUBROUTINE TRANSLATES AND ROTATES THE FIXED INpUT ♦♦♦♦♦CRD02000 

♦♦♦♦♦ COORDINATES RELATIVE TO A SYSTEM V«ITH POSITIVE X AXIS ♦♦♦♦CRD02100 
♦♦♦♦♦ along the wind DIRECTION THETA, CRD02200 

N = 0 CRD02300 

B = AMOD(YO,3toO,0)+RAD CRD02400 

IF (ICK .EQ. 2) 60 TO 10 CRD02500 

A = THETA(M) CRD02600 

GO TO 11 CKD02700 

5 A = THETA (JF) CRD02800 

I XP = XO^SIN(B) CRD02900 

YP = XO#COS(B) CRD03000 

A = A*RAD CRD03100 

B = COS(A) CRD03200 

A = SIN(A) CRD03300 

OY = D£LY(M)^RAU CRD03400 

DX = UELX(M)♦SI^(DY) CRD03500 

DY = DELX(W)^COS(UY) CRD03600 
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39* 

20 

IF (ICK .£Q, 2) GO TO 50 

CRD03700 

ifO* 


XI = XP-DX 

CRD03800 



Y1 = YP-Dt 

CRD03900 

42* 


X = -X1*A-Yl»b 

CRD04000 

43* 


Y = X1*B-Y1*A 

CRD04100 

44* 


IF (X ,LE. 0»0) go to 80 

CRD04200 

45* 


IF (KSW(2) .EQ, 0) GO TO 40 

CRD04300 

46* 


XS = SQRT(Xi*Xl+Yl*Yl) 

CRD04400 

47* 


A5P = O.O 

CRD04500 

46* 


IF (XI) 3lr30r3l 

CRD04600 

49* 

30 

IF (Yl) 3lf90r3l 

CRD04700 

bO* 

31 

ASP s 1.5707963-ATAN21Y1»X1) 

CRD04800 

bl* 


IF (ASP #LT, 0.0) A&P = ASP+6, 2831853 

CRD04900 

b2* 


60 TO 90 

CRD05000 

b3* 

40 

IF (NBK .EQ, 0) GO TO 90 

CRD05100 

b4* 


IF (ICK .EQ. 2) GO TO 90 

CRD05200 

b5* 


IF (KK .ET. leOT.OR.KK .GT, ITOp) GO TO 90 

CRD05300 

b6* 


IF (XAST(M) ,LE. 0,0) GO TO 80 

CRD05400 

b7* 


ASP = THETA (JF)*RAD 

CRD05500 

b8* 

50 

XS = (THETA(M)+180,0)*RAD 

CRD05600 

b9* 


OX = DX+XAST(M)*SIN(XS) 

CRD05700 

bO* 


D1 = DY+XAST(M)*C0S(XS) 

CR005800 

bl* 


IF (ICK ,EQ. 2) GO TO 21 

CRD05900 

b£* 


XI = XP-DX 

CRD06000 

b3* 


Yl = YP-DY 

CRD06100 

b4* 


XS s ■^Xl*SlN(ASP)^Yl*COS(ASP) 

CRD06200 

b5* 


A = AbS (THETA (M) -THETA (JF ) ) 

CRD06300 

b6* 


IF (A .GE, 180,0) A = 360,0-»-A 

CRD06400 

b7* 


IF (A .GT, 45,0) GO TO 60 

CRD06500 

b6* 


IF (XS ,LE. 0,0) GO TO 90 

CRD06600 

b9* 


GO TO 60 

CRD06700 

70* 

60 

CALL SIGMA(XAST(M) »M»3) 

CR006800 

71* 


ASP r A*RAD 

CRD06900 

72* 


SIGY = 2.15*SQRT( (SI6X*SIN(ASP) )**2+(SIGY*C0S(ASP) )**2) 

CR007000 

73* 


IF (A .GT, 90,0) GO TO 70 

CRD07100 

74* 


IF (X .GT, XAST(VI)+SI6Y) 60 TO 80 

CR007200 

75* 


IF (XS ,L£, 0,0) GO TO 90 

CH007300 

76* 


IF (X ,LT. XAST(M)) GO TO 90 

CRD07400 
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77* 

eo TO 80 

CRD07500 

7B* 

70 IF (X .LE, XAST(M)+SieY) GO TO 90 

CRD07600 

79* 

80 N = 9 

CRD07700 

BO* 

90 RETURN 

CRD07800 

Bl* 

END 

CK007900 
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1 * 

2 * 

d* 

k* 

5* 

6 * 

7* 

8 « 

9 * 

10 » 

11 * 

12 * 

13* 

14* 

15* 

16* 

17* 

16* 

19* 


subroutine SlOMAr VERSION 5, REVISION 0 

subroutine sigma (XP»M»MM) SiGOOlOO 

common /PARAMT/ TESTN0U2), ISKIP ( 15) »NXS»NYS»N2S»NDI » NCl » SIG00200 

lNBK,NPTS»NVbfNVbfXX(41) ,YY(4X) »ZU6) fOELXUS) .DELYdS) ,Q(l5) » S1G00300 

2UdARK( 16) »SiGAK(16) »S1GEK(16) »SiGX0(15) ,SIGY0(15) »SIGZ0(15) » SIG0C400 

3ALPhA( 20) »BETA(20) »2RK»TlMAVrTHETAK(lb) »TAUKr TAU0K»H»XRY»XRZ» SIG00500 
4XLRY»XLRZ»ZZL(4U) »IZM0D(15) »DECAY»ZLIM»TIMl»LAMBDArDl (10) »CI (10) r SIG00600 
5TAST(05) »UB0T(05 ) »jTOP(05) »VS(20) »PE;RC (20) »ACCUR»VB(20) »PERCB(20) »SIG00700 
6HB t aLPHL ( 05 ) , BETL ( 05 ) » TAUl f TAUOl , ZRL » UBARL ( 10 ) » SiGAL ( 10 ) » SIGEL ( 10 ) S1G00800 
7»THETAL(10)rGAMMAP(ii0)fNTl,TI(l0)»NPSfNAMCAS(12) S1G00900 

common /PARAMS/ UBAR(20) »SIGAP(20) ,DELThP( 20) »SlG£P(20) »THETA (20 ) iSIGOlOOO 
lO£LU(20)>VER,VREF»PE.AKDr5lGZfSlGYiSIGX»SQR2P»U»TH»I»J,KK»STOl» SIGOllOO 
2ST02»ST03»TRDf lLK»RADfNNZ,lT0P»lB0T»XAST(21 ) »SIGXNK»JF»PPwR»QPWR» SIG01200 
3MPWR,II»DEP,XBARX»SOBAR»NXCI»LAT»SIGYnK» 6AMMA(20) »NCC»NDD»NTTf SIG01300 
4NCCC»NDDDrNTTT»NSW2»M00LS(l5) »KSW (5) »LINES» IMl »MDLS»NWD» SIG01400 

5YSV(41) ,Y0ARY(4l) rUbARNK(41) »BETANK(41) ,ALPHNK(41) »ANG(42) » SIG01500 

65ieENK(4l) iSlGANK(4l) »0EPN(41»4l) ,RNG»AZM»IDATE(2) »ITIME(2) »YT, SI601600 
7NYSSrCDAMX(3) SI6Q1700 


20* 


integer testno 

S1G01800 

21* 


REAL MPWRrL»LAMBDA 

S1G01900 

22* 

C 

**♦♦♦ this subroutine calculates the 

standard deviations of X*Y*ZSIG02000 

23* 


X s XP 

SIG02100 

24* 


IF (MM ,EQ. 2) X = XAST(M) 

SIG02200 

25* 


MMM = 1 

SIG02300 

26* 


SiGZ = 0*0 

SIG02400 

27* 


SIGY = 0.0 

S1G02500 

28* 


SIGX = 0*0 

SIG02600 

29* 


N = MOOLS(M) 

SIG02700 

30* 


GO TO (40*20*30) *N 

S1G02800 

31* 

20 

SIGY = SIGYO(M) 

SIG02900 

32* 


SIGX = SIGXO(M) 

SIG03000 

33* 


GO TO 220 

S1G03100 

34* 

30 

B3 = SXGEP(M) 

SIG03200 

35* 


B4 5 BETA(M) 

S1G03300 

36* 

40 

A1 5 1,0 

SIG03400 

37* 


A2 = SlGYO(M) 

S1G03500 

38* 


A3 = SIGAP(M) 

S1G03600 
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39* 


A4 = alpha (M) 

40* 


A5 = DELThP(M) 

41 + 


A6 =: SlGXO(M) 

42* 


L = 0.0 

43» 


IF (DLLU(M) .LE. 0,0) 60 TO 45 

44* 


L = 0.28*X*uElU(M)/OBAH(M) 

45* 

45 

IF (MM ,EQ, 1) 60 TO 60 

46« 


N = 1 

47* 


GO TO 60 

48* 

50 

Ti = (THErA(M)-THETA(JF) )*RAO 

49* 


A1 s 1.0 

50* 


T2 = SIN(Tl) 

51* 


Tl = COS(Tl) 

52* 


A2 = SQRT( (5IGX*T2)**2+(S1GY*T1)**2 

53* 


A3 = 51GAP(JF) 

54* 


A4 = alpha (OF) 

55* 


A5 = D£LThP(JF) 

56* 


A6 = SORT( (SI6X*T1)**2+(SI6Y*T2)**2 

57* 


B3 = 5I6EP(jF) 

58* 


B4 s BETA(sJF) 

59* 


L = 0,0 

60* 


IF (DELU(oF) ,LE, 0.0) 60 TO 60 

61* 


L = C,28*X*DELU(JF)/UBAR(JF) 

62* 

60 

IF (A4-1.0) 70i80»70 

63* 

70 

A1 = 1.0/A4 

64* 


IF (MMM ,£Q, 2) GO TO 90 

65* 


IF (A2-A3*XRY) 80.b0.90 

66* 

80 

XY = A2/A3 

67* 


GO TO 91 

68* 

90 

XY = a 4*XRY#(A2/(A3*XRY) )**Al+XRY*( 

69* 

91 

IF (MMM .EQ, 1) XY = XY^XlRY 

70* 


IF (XY ,LT, 0.0) XY = 0,0 

71* 


IF (A4-1.0) Ii0.l00»110 

72* 

100 

Tl = A3*(X+XY) 

73* 


GO TO 120 

74* 

110 

Ti = (X+XY-XRY*(1.0-A4) )/(XRY*A4) 

75* 


IF (Tl ,LE. 0,0) GO TO 125 

76* 


Tl = a3*XRY*T1**A4 


SIG03700 

SIG03800 

51G03900 

SIG04000 

SIG04100 

S1G04200 

SIG04300 

S1G04400 

SIG04500 

S1G04600 

SIG04700 

SIG04800 

51604900 

51605000 

SI605100 

5IG05200 

SI605300 

51605400 

5iG05500 

S1G05600 

SIG05700 

SIG05800 

S1G05900 

SIG06000 

SI606100 

51606200 

51606300 

SIG06400 

51606500 

S1G06600 

51606700 

5IG06800 

51606900 

51607000 

51607100 

S1G07200 

51607300 

51607400 
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11 * 

IQ* 

19* 

QQ* 

til* 

ti2* 

ti3* 

ti4* 

Qb* 

Qb* 

07* 

tiB* 

Q9* 

90* 

91* 

92* 

93* 

94* 

95* 

96* 

97* 

9B* 

99* 

iUO* 

lOl* 

102 * 

103* 

104* 

105* 

106* 

107* 

106* 

109* 

110 * 

111 * 


1^0 

T2 = ABS(A5)*A*4,05ti9052E-3 

SIG07500 


S16Y = SQKT(Tl*Tl+T«i*T2) 

SIG07600 

16b 

Sl6X = SQKT(L*L*.05‘+06329 +a6*a6) 

SIG07700 


IF IN ,EQ. 1) GU TO 220 

S1G07800 


GO TO (I50»i30) »MFiM 

SIG07900 

130 

IF tB4-ltO) l40rl3lrl4C 

SIG08000 

Ibl 

X2 = X 

siGoeioo 


GO TO 190 

51606200 

140 

Ti = X/XRZ 

SIG06300 


GO TO 210 

S1G06400 

160 

IF (64-1.0) 151»160»lbl 

S1G08500 

Ibl 

61 - l,0/6‘^ 

SIG08600 


IF (SI6Z0(K)-tJ3*XF<Z) 160rl60»l7o 

51608700 

160 

XZ = SIGZ0(M)/B3-XlRZ 

S1G08800 


GO TO 180 

S1G08900 

170 

XZ = 64*XRZ*(iIoZ0(N'.)/(B3*XRZ) )**bl-XLRZ+XRZ*(1.0-B4) 

5IG09000 

ItiO 

IF (XZ ,LV. 0,0) XZ = 0,0 

• S1G09100 


XZ = x+xz 

SIG09200 


IF (B4-1.0) 200,190»20C 

SIG09300 

190 

SIGZ = B3*XZ 

S1G09400 


GO |0 220 

SIG09500 

200 

Tl = (XZ-XRZ*(l,0-b4) )/(B4*XRZ) 

5IG09600 


IF (Tl .Lt, 0,0) GO TO 220 

S1G09700 

210 

SIGZ » B3*XKZ*Tl**t>4 

SIG09800 

220 

continue 

SI609900 


IF (MM ,Nt, 2) gO to 240 

SIGIOOOO 


IF (MMM .tO. 2) GO TO 230 

SIGIOIOO 


N c 2 

51G10200 


X = XP 

SIG10300 


MMM = 2 

SIG10400 


GO TO 60 

SIG10500 

230 

SIGaNK = SIGX 

5IG10600 


sigynk = sigy 

51G10700 

240 

rlturn 

S1G10800 


END 

SIG10900 
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2 * 

5* 

4 * 

5 * 

7* 

8 * 

9* 

104c 

114c 

124c 

134c 

144c 

154c 

164C 

174c 

164c 

194c 

204c 

21 * 

22 * 

234c 

24* 

25* 

26* 

274c 

28* 

29* 

30* 

31* 

32* 

33* 

34* 

35* 

36* 

37* 

38* 


SUBkOUTINE; ItSTR^ version 5» REVISION 0 


c 

c 


SUbROUTiNE TESTR(kTK) 

COtvihON /PaRaMT/ TtSlN0(12)f ISKIP ( 15) »NXS »1 mYS»n2S »NDI »NCI » 

lNDK,NPTS»NVS»NVbfXX(4i) » YY(41) »2U6) »UELX(15) »DELY(lb) »G(l5) » 
2 UuARK( 16) »SI6AK(16) »SIGEK(16) »SIGX0(15) »SI6Y0(15) fSIGZOUb) » 
3ALPhA(20 ) » beta ( 20) , 2RR , TIMAV rTHgTAK ( 16) , TAUK f TAUOK »h» XRY » XRZr 
4 XLRY»XuRZ» 22L(40) r*2MGD(l5) » DECAY r 2LlN » TIMl , LAMBDA »DI( 10 ) ,CI(10) » 
bTASKOb) »uBOT(05) »jT0P(05) , VS (20 ) » PERC (20 ) » ACCUR» VB (20 ) » PERCB (20 ) 
6Hb»ALPHL(05) ,bETL(0b) ,TAU u,TAUCL» 2RL»UBARL(10) rSlGAL(lO) »SI6EL(10 
7 PTHeTAL( 10) r6AMMAP(2C) » NT 1 , TI ( lO ) » NPS » NAMCAS ( 12) 

COMMON /PARaMS/ UBaR(20) »SI6AP(20) »DELTHP(20) »S JGEP (20 ) » ThETA ( 20 ) 
1DELU(20) »VER»vREF»PEAKD»Sl6Z»SlGY»SIGX»S(5R2P»L»TH,I»J,KK»ST01r 
2S1 Ob , ST03 r TRD r I LK » RAD r NNZ , I TOP r IBOT » XAST ( 21 ) » SI GXNK » OF , PPwR » QPWR » 
3MPWR , 1 1 » Dtp r Xd ARX » SCBAR » NXC I » LAT » S IGYNK » GAMMA ( 20 ) » NCC f NDD » NTT » 
4 NcCC»NODD»NTTT »NSW2»M0DLS(15) »KSW(5) »LINES» IM1,MDLS»NWD» 

5 YSV( 41 ) »Y 6 ARY( 41 ) ,Ut>AKMK( 41 ) *BETANK( 41 ) »ALPHNK( 41 ) » ANG( 42 ) t 
6 SiG£NK( 41 ) »SI 6 ANK( 41 ) » DEPN ( 41 , 4 l ) , RN 6 » AZM» IDATE ( 2 ) , ITIME ( 2 ) »YT» 
7 NYSb»CUAMX( 3 ) 

Integer testno 

RtAL MPWRfLrUAMBDA 

This subroutine determines THE STRUCTURAL CHANGE IN LAYERS FOR 
The pull transition model 

IF (NBK .tO, 0 ) GO TO 100 
IF (KTK .EG. 0 ) GO TO 50 
IF (KK , 6 E. JbOT(IlR)) <50 TO 50 
IbOr = JBOT(IlK) 

ITOp = uTOP(IlK) 

GO TO 61 

50 IF (KK .NE. JbOT(lLK)) GO TO 61 
loOT = KK 
1 1 op = jTOP(IuK) 

DO 60 J=IdOT»ITOP 
60 XAST(J) = UbAK(J) 4 crAST (ILK) 

Ilk = lLK +1 
ol CONTINUE 
KTK = 0 
100 CONTINUE 


TSTOOlOO 

TST00200 

TST00300 

TST00400 

TST00500 

TST00600 

»TST00700 

)TST00800 

TST00900 

»TST01000 

TSTOllOO 

TST01200 

TST01300 

TST01400 

TST01500 

TST01600 

TST01700 

TST01800 

TST01900 

TST02000 

TST02100 

TST02200 

TST02300 

TST02400 

TST02500 

TST02600 

TST02700 

TST02800 

TST02900 

TST03000 

TST03100 

TST03200 

TST03300 

TST03400 

TST03500 

TST03600 
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40 * 


RtTuRN 

Einu 


TST03700 

TST03800 
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2* 

■5* 

4* 

5* 

b* 

7* 

b* 

9* 

1C>K 

!!♦ 

12 « 

13 % 

14* 

15« 

16 * 

17* 

16* 

19* 

20 * 

21 * 

22 * 

23* 

24* 

25* 

2b* 

27* 

26* 

29* 

30* 

31* 

32* 

33* 

34* 

35* 

36* 

37* 

36* 


subkoutin^: 


ISOr VEKSIOfM 5, REVISION 0 


ISOOOlOO 

IS000200 

IS000300 

IS000400 

IS000500 

IS000600 

>15000700 


»ANG(42 ) f 
-ITlMt(2)»YT, 


Subroutine iso(NR»p/iT) 

CuMmON /PARAMT/ TESTN0U2), ISKIP ( 15) » NXS f nYS » NZS »NDI »NCI » 

lN6K,NPTSriMVS» Nvb» XX 141 ) ,YY (41) »2(16) »uELX(l5) ,DELY(lb) ,Q(l5) » 

2Ut>ARK(l6) »5IGAK(16) » SlGEK ( 16) » SjGXO (15) »SIGYO(15) rSIG20(l5)» 

3ALPhA(20) fBETA(20) ,2 Rk,TIMAV»THeTaK ( 16) fTAUKf TAUOK»hfXRY»APZ» 

4XlRY»XLRZiZZL( 40) il2M0D(15) rDECAY»ZLIM»TI^il»LAMBDA»OI (10) fCKlO) » 

5TaST( 05) »UBOT(05) » jTOP(Ob) ,VS(20) rP£RC(20) »ACCUK»VB(20 ) »PeRCB(20) »IS000700 
6Hd»aLPHL( 05) »BETL{Qt5) » TAUL , TAUOL » ZRL » UBAHL ( 10 ) » SiGAL ( 10 ) » SIGEL ( 10 ) IS000600 
'ft { HcTAL ( 10 ) f GAMiViAP (20 ) » NT I , TI ( lO ) » NPS , NAMCAS ( 12 ) TC<^^,flQr>n 

common /PARaMS/ UBAH(20) rSIGAP(20) »DELTHP(20) »SIGEP(20 ) »ThETA( 20) 
lUtLU ( 20 ) » VER f VREF f PEAKD » S I GZ » S I gY » S IGX , SQR2P » L f TH r I » J » KK » STOl » 
2STO^,ST03fTKD»ILK»RAD»NNZ,iTOP»i80T»XAST(2l) »SI gXNK»JF»PPWR»QPWR» 

3MPWR ,11, Dtp , XbARX t SQBAR i NXc I » LAT » SI GYNK t GAMMA ( 20 ) » NCC » NOD , NTT » 

4NCCC t NDDD » NTTT » NSw 2 » MODUS ( 15 ) , KSW ( 5 ) , LINES r IMl » MDLS t NV<D t 
5YSV(41) fY6AKY(4i) , u 6ARNK(41) »bETANK(4i) ,ALPHNK(41) 

6SiGc.NK(4l) rSlGAwK(4l) »0EPN(41r4l) ,RNGrAZMrIDATE(2) 

7NYSS»CDAMX(3) 

DIMENSION ERFX(6) 
eUUiVAUENCE (ANG(IO) »£RFX) 

IiMTfcGER TESTNO 
Real MPWR»L,LMMdDA 

DOUbUE precision A6*A7»A6,A9rAlU»All»DTX 

This subroutine EVaI-UATES £RF(X) . 

Data A6,A7iA8,A9»Al0fAll/,0705230764D0, ,0422620123D0» ,0092705272DOIS002400 
1» .0001520143D0» .0002765672Q0» .0000430636DO/ IS002500 

DO iO M=MR,|v,T IS002600 

IN = 0 IS002700 

IP (ERFX(M) ,lT. 0,0) IN = 1 IS002800 

ERFx(M) = ABS(ERFX(M) ) IS002900 

IF (ERFX(M) ,LT, I.CE-IO) GO TO 5 IS003000 

IF (ERFX(M) ,gT. 5,0) GO TO 6 IS003100 

D'lX = 1,OD0 +EKFX(M)*(m6+£RFX(M)*(a7+ERFX(M)*(A6+ERFX(M)*(a9+ERFX(MISO03200 
1)*(A10+ERFX(M)*m11) ) ) ) ) IS003300 

EKFX(M) = 1,ODO-(1,ODO/DTX)**16 IS003400 

GO TO 7 IS003500 

5 £KFX(M) = 0,0 IS003600 


IS000900 

rlSOOlOOO 

ISOOllOO 

IS001200 

IS001300 

IS001400 

IS001500 

IS001600 

IS001700 

IS001600 

IS001900 

IS002000 

ISO02100 

IS002200 

IS002300 
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59* 

60 TO 10 

IS003700 

40« 

6 EKFX(M) = 1.0 

IS003800 


7 IF (IN ,EOf 1) £RFX(M) = -£RFX(M) 

IS003900 

^Z* 

10 CONTINUE 

IS004000 

«+3* 

RETURN 

IS004100 

44* 

END 

IS004200 
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1* 

SUBROUTINE Rb8» VERSION 5» REVISION 0 

FUNCTION RBtJ(A»B»C) 

RB300100 

4* 

Rti8 = AL06(A/B)=*‘C 

RB600200 

5« 

IF (RB8-I-1.0) 20ti0»20 

RB800300 

6« 

10 Rb8 = -.99999999 

RB800400 

7* 

20 Rb3 s RBB-t-l.O 

RB800500 

B* 

RETURN 

RB800600 

9« 

END 

RB800700 
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1* 

subroutine KBllr VERSION 5i REVISION 0 


2* 



3* 

FUNCTION RBU(PARMfPfZ»2RK) 

RBlOOlOO 

4* 

RBli = PARM*(2**P-^RK**P)/(P*(Z-2RK)*2RK**(P^1.0) ) 

Rbl00200 

5* 

RETURN 

Rbl00300 

b* 

END 

RB100400 
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1* 

z* 


SUBKOUTiNt SPuIHEr VEKSION 5, REVISION 1 
subroutine SPL I NE ( X » y , a » B » C f D » N , I ER ) 

SPLOClOO 

4* 


DIMENSION Xa)»Ya)»AU)»bU)»Ca)tD(l) 

SPL00200 

*>♦ 


IcR = 0 

SPL00300 

6* 


C(l) = 0,0 

SPL00400 

7* 


C(N) = 0.0 

SPL00500 

8* 


Q = 1,07179677 

SPE00600 

9* 

C 

Q = 4,0*(2.0-SQkT(3.0) ) 

SPL0C700 

1Q« 


NP = N-1 

SPL00800 

ll* 


DO iO I=1,NP 

SPL00900 

IZ* 


All) = XU+D-XII) 

SPEOIOOO 

13+ 


BID = (Y(I + 1)-Y(I) J/AII) 

SPLOUOO 

14* 


IF ll ,LT. 2) 60 TO 10 

SPL01200 

15* 


ClI) = 2,0*(B(D-B(I-1) )/(A{I-l)+A(I) ) 

SPL01300 

JL6« 


Dll) = CU)*1,5 

SPL01400 

17* 

C 

DID = CU)*3, 0/2,0 

SPL01500 

18* 

10 

CONTINUE 

SPL01600 

19« 


NIM = 0 

SPU01700 

zo* 

20 

XM =0,0 

SPL01800 

zi* 


Do 30 I=2»Np 

SPL0191)0 

zz* 


YP = Cll+1) 

SPL02000 

23* 


YP = Q*( ( lYp-C(I-l) )/ll.O+AlI)/AlI-l) )-YP)*0,5-C(I)+D(I) ) 

SPL02100 

24* 


IF lABS(YP) ,ST, XM) XM = ABSlYP) 

SPL02200 

Zb* 


ClI) = Cti)+YP 

SPU02300 

Zb* 

30 

CONTINUE 

SPL02400 

Z7* 


NTM = NTM+1 

SPL02500 

Zb* 


IF (NTM ,LT, 80) 60 TO 35 

SPL02600 

Z9* 


lER = 1 

SPL02700 

30« 


60 TO 36 

SPL02800 

31* 

35 

CONTINUE 

SPL02900 

3a* 


IF (1,0E-3 ,UE. XM) 60 TO 20 

SPL03000 

33* 

36 

CONTINUE 

SPL03100 

34* 


DO 40 I=1»NP 

SPL03200 

35* 


All) = ICIDD-CID )/AlI) 

SPL03300 

36* 

40 

continue 

SPL03400 

37* 


RETURN 

SPL03500 

38* 


END 

SPL03600 
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!♦ 

a* 

3 * 

4* 

5* 

b* 

7* 

8* 

9* 

10 * 

ll* 

12 * 

13 « 

14 » 

lb* 

16 * 

17* 

Ibt 

19 * 

no* 

21* 

22 * 

22 * 

24* 

25* 

2b* 

27* 

26* 

29* 

30^ 

31* 

22 * 

22 * 


SOBROUTiNc LLPLOT, VERSION 6, REVISION 0 

subroutine LLPLOT(YAH»XARfNfTlTLE»CRIT»NCRlT»NWo»VERTcL»NcV»2BB» LLPOOlOO 
li:iT) ULP00200 

common /XYXYPT/ YP(41) rXP(41) f A{41) »B(41) ,C(41) ,D(41) >XI(41) »YI (41ULP00300 
l)fNUM(3)»NC LLP00400 

COMMON /ILPLTS/ XMAXfXMIN, YMAX, YMiN»XLMl»Y6MlrHT»CHARF»SCLX»SCLY» LLP00500 
1XSIEE1»YSIZ£1 LLP00600 

dimension XaR(I) ,YaRU) »LInE(12o) rTlTLE(l) iCRlTa)»XF(l) »YF(1) » LUP00700 

IFoDX(b) ,LEXp(3) rVERTCuU) LLP00800 

common /iLALPn/ UCRIT 1 10 ) , IBLaNk » ISTAR , IP l » lP2r iPSihUABEL (5) »NCH LLP00900 

Common /pltluo/ isw»xmaxjn,ymaXjNiXci2e»ycize llpoiooo 

data HLABEL/27HALONGWIND DISTANCE (METERS) /»NCH/27/ LLPOllOO 

data IBLANK/lh /»LCRn/2HA=»2HB=»2HC=r2HD=f2HE=»2HF=r2HG=f2HH=,2HILUP01200 
l=»2hJ=/fISTAR/lh+/ LLP01300 

EOUIVALENCE (FLDX»Hi-A6EL) » (LINE,B) » (XF,XI) » (YF»YI) UP01400 

EQUIVALENCE (XLMI.nND) » (Ybm1»NST) , (HT»IPWRX) » (ChARF» IPWRY) , (SCLXf FLLP01500 
III) , (SCLYfll) » ( aSIZE 1»1EXP) f ( YSlZElfPWRY) ULP01600 

data LEXP/2H5-»2H2-»2h / LLP01700 

2010 format (7x»xH(,20(6H )»1H)) LLP01800 

2020 format (4X»3hlO-,lHl»3(U(lH-) »1H1»15(1H") »1HI»11(1H-) flHl) »1H)/8 XllP01900 


2030 

2040 

20b0 

2oao 

2090 


lf3(ll»39X) »Il/6Xf3(2H10»llX»lh2,lbX»lH5»10X) » 2H10/54X , 5A&) 


format (lX»Al»3X»A2»lh(»l20AlflH)) 

FuRmAT (lXrAl»3Xf I2*lhl »120A1»1 h) ) 
format (1a»a1»2X»4H10-( »120A1»1h) ) 
format (2(5(1QX,A1»1H=»E10,3»1H,)/) ) 

format (86Hu ** NO PLOTS THIS CaSE — DOSAGE OR CONCENTRATION 
lEb are probably OUT OF RANGE ♦♦//) 

FiND XMIN, aMaX, YMIN> YMAX 
YmAa = -1.E20 
NND = N+1 


NST = 
NS>T = 


0 

l\iST+l 


LLP02000 
LLP02100 
LLP02200 
LLP02300 
LLP02400 
VALULLP02500 
LLP02600 
LLP02700 
LLP02800 
LLP02900 
LLP03000 
LLP03100 


34* 

IF 

(NST (GE* 

N) 60 TO 

500 






LLP03200 

35* 

IF 

(XAR(NST) 

• Lc. • 0*0 

.OR. 

YAR(nST) 

.LE. C.O) 

GO 

TO 

5 

LLP03300 

36* 

10 NND 

:: NND**1 








LLP03400 

27* 

It- 

(NND fUE, 

1) GO TO 

500 






LLP03500 

28* 

IF 

(XAH(NND) 

.Le. 0*0 

.OR. 

YAR(NND) 

.LE. 0.0) 

GO 

TO 

10 

ULP03600 
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If-' (NNU .UE, imST) GO to 500 

ULP03700 

40* 


DO 15 IrNSTrNrJD 

UUP03800 

41* 


Ir (XaR(I) .UE. 0.0) 60 TO 500 

UUP03900 

42* 


XF(i) = XaR(I) 

LLP04000 

43* 


IF (ISrt ,NE. 2) XF(1) = ALOGIO ( XAH ( I ) ) 

UUP04100 

44* 


IF UAR(I) .UE. 0.0) 60 TO 14 

ULP04200 

45* 


YF (1) = ADOo10(YAR(I) ) 

LLP04300 

46* 


IF (YMAX .UT. YF(I)) TMAX = YF ( I ) 

LUP04400 

47* 


60 TO 15 

ULP04500 

48« 

14 

YFCi) = -1.E20 

ULP04600 

49* 

lb 

CONTINUE 

LUP04700 



IPrtKX = INT(XF (imST)+100.0)-100 

LLP04800 

bl + 


IPWkY = INT(YNiAX+100.0)-102 

ULP04900 

t>2* 


IF (IPWRX .uT. 2) IPWRX = 2 

ULP05000 

b3* 


P^RT = FUOAT(IPwRY) 

ULP05100 

b4* 

C 

print title information 

LLP05200 

b5* 


CaUl PRTTTU ( NWD » U INES » ti tle r -1 . 0 » 0 . 0 » 2BB f ZTT ) 

ULP05300 

b6* 


write (6»20l0) 

UUP05400 

t>l* 

C 

loop for 48 printer uines 

UUP05500 

b8« 


ONl = 0 

ULP05600 

b9* 


Jn2 = 1 

ULP05700 

bO* 


01 = 0 

ULP05800 

bl* 


IbT = (48-NCV)/2 

UUP05900 

b2* 


DO 220 I=i»48 

UUP06000 

b3* 


lAl = UEXP(3) 

UUP06100 

bH« 


IF (I .UT. 1ST) GO TO 17 

UUP06200 

b5* 


01 = OT+1 

ULP06300 

bb* 


IF (uT ,GT. NC\/) 60 TO 17 

ULP06400 

b7* 


OnI z OKl+1 

LLP06500 

bb* 


IF loKl .UT, 7) GO TO 16 

UUP06600 

b9* 


OM = 1 

LLP06700 

70* 


On2 z wK2+1 

UUP06800 

7X* 

16 

CmLi. MSFUD(1ABS(6»(0K1^1) ) ,6»VERTCU(0K2) »0.IAI) UUP06900 

72* 

17 

continue 

ULP07000 

/3* 


11=46-1 

UUP07100 

74* 


FII = float (ID ♦ 0.002b 

ULP07200 

75t 


IF (NCRIT) b0»60»20 

UUP07300 

76* 

20 

IF (NCRIT .£Q, 9) GO TO 60 

ULP07400 
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77* 

DO 40 KK=l»NCRIT 

LLP07500 

78* 

XF (CRIT(KK) ,Lt. 0*0) 60 TO 40 

LLP07600 

79* 

IF (AbS(Al0610(cRIT(KK) )-FII-PWRY) .GT, 0,031255) GO TO 40 

LLP07700 

80* 

00 30 LL=1*120 

LLP07800 

til* 

30 UN£(Lt) = LCHIT(KK) 

LLP07900 

82* 

GO TO 67 

ULP08000 

83* 

40 continue 

LLP08100 

84* 

60 DO 65 0=1*120 

LLP08200 

85* 

65 UNc(O) = IbUANK 

LLP08300 

86* 

67 DO 70 J=NST,Ni\iD 

UP08400 

87* 

IF (ABS(YF(U)-FII-PWRY) ,GT. 0.031255) GO TO 70 

LUP06500 

88* 

L 5 INT(XF(u)*40,0+0,5)-40*lPWRX 

LtP06600 

89* 

IF (L *LT, 1 ,0k, U *0T, 120) GO TO 70 

LLP08700 

90* 

U1N£(L)=ISTaR 

LLP08800 

91* 

70 CONTINUE 

U-P08900 

92* 

IF (15-1) 90*80,90 

ULP09000 

93* 

80 ItXp=lPWRY*2 

LLP09100 

94* 

GO TO 130 

LLP09200 

95* 

90 IF (31-1) 110*100*110 

LLP 09300 

96* 

100 IEXp=iPWRY+l 

LLP09400 

97* 

GO TO 130 

LLP09500 

96* 

110 IF (47-1) 140*120*140 

LLP09600 

99* 

120 ItXp=lPWRY 

LLP09700 

100* 

130 IF (I ,6T, 1) WRITE (8*2040) lAl * iEXP*UINE 

LLP09800 

101* 

GO TO 220 

LLP09900 

i.02* 

140 IF (16-1) 150,170,150 

LLPIQOOO 

103* 

150 IF (32-1) 160,170,180 

LLPlOlOO 

104* 

160 IF (48-1) 175,170,175 

LLP10200 

105* 

170 IF (1 .EO. 1) eo TO 220 

LLP10300 

106* 

IF (1 .EO. 48) GO TO 171 

LLP10400 

107* 

WRITE (6*2050) IAI*I-INE 

LLP10500 

108* 

GO TO 220 

LLP10600 

109* 

171 XPl = IPWRX+1 

LLP10700 

HO* 

IP2 = IPWRX^-2 

LLP10800 

111* 

IP3 = IPWRX+3 

LLP10900 

112* 

WRITE (6*2020) iPWRX* IPl * IP2, lP3*FtOX 

LLPllOOO 

113* 

GO TO 220 

LLPlllOO 

114* 

175 IfcXp = 3 

LLPH200 
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ilb« 


I»= tM0D(I»l6) 

*ImE. 5) 00 TO IbO 

LLP11300 

U6* 


XtXp = 1 


ULP11400 

117* 


GO TO X90 


ULPU500 

ilQ* 

IbO 

It (M0D(I»16) 

,EQ. 11) lEXP = 2 

LLP11600 

il9* 

190 

IF a .GT. 1) 

WRITE (6,2030) 1AI,UEXP(IEXP) ,LINE 

ULP11700 

lao* 

220 

continue 


LLPiiaoo 

i21« 


IF (NCRIT .gT 

. O.ANO.NCRIT .LT. 9) WRITE (6,2080) 

(LCRlT(I)»CRlT(iULPll900 

122* 


1)»I=1»NCRXT) 


UP12000 

123* 

370 

RETURN 


LLP12100 

124* 

500 

WKITE(6,2090) 


ULP12200 

a25* 


RETURN 


LLP12300 

126* 


END 


UP12400 
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1* 

2* 

5* 

SUBkOUTINE ISSOPT, VERSION 6, REVISION 0 

subroutine lSS0PT(X»YH\X»NYfFI»LE6ENDrNCHARfDPfNYSrXX»DR»II»IREC» 

YiSSOOlOO 

4* 

1T»IsW3»KHNE»NCV»sJM»D£CAY,UAMBDA»2B»ZT) 

ISS00200 

5* 

COMMON /PLTlSU/ SUL»XMAXIN,YMAXlNfXSUErYSIZE»RASTIN»viSW 

ISS00300 

&♦ 

common /BNDS/ XRITfXLFTfYBOT»YToP»XPLrYPL 

ISS00400 

7* 

dimension X(1) ,Y(1) fFI(l) »DP(41rl) »XX(1) ,DR(245,1) »NPPX4) » YY ( 1 ) 

IS500500 

8* 

dimension TLABEL(3) 

ISS00600 

9* 

dimension LEGEND(I) »KLINE(1) 

ISS00700 

10* 

real LAMBDA 

ISS00800 

11* 

dimension KB(4) 

ISS00900 

12* 

COMMON /XYXYPT/ YP(41) ,XP(4i) f A(41) ,B(41) rC(41) ,D(41) ,XI(4l) » YI (41ISS01000 

13* 

1) rNuM(3) riNC 

ISSOllOO 

14* 

EOUIVALENCE (YP,YY) 

ISS01200 

15* 

data XLM»YBM»XRM»YTM»DISP/62.»102.»24.r22.»3,/ 

ISS01400 

16* 

data radi/57.295779/ 

ISS01500 

17* 

data TLABEL/17HDISTANCE (METERS)/»NCTh/l7/ 

ISS01600 

18* 

COMMON /ILPLTS/ XMaX » XMIN , YMAX » YMIN r XlMI r YBMl r HT » CHARF r SCLX f SCLY » 

ISS01700 

19* 

1XSI2E1»YSIZe1 

ISS01800 

20* 

common /ILALPH/ LCRIT(IO) .IBLANk»ISTAR,.IP1»IP2»IP3»HLaBEL(5) »NCH 

ISS01900 

HI* 

data rad/. 017453293/ 

ISS02000 

22* 

XYTeRP(A»B»C»D»E) = B"(D-E)*(B-A)/(D-C) 

ISS02100 

23* 

NV»D = NCHAR/6 

ISS02200 

24* 

IF IISW3 .EQ. 1) 60 TO 50 

ISS02300 

25* 

XLMl = XLM 

ISS02400 

26* 

Yt>Ml = YBM 

ISS02500 

27* 

XRMl = XRM 

ISS02600 

28* 

YTMi = YTM 

ISS02700 

29* 

XSIZEI = XSlZE 

ISS02800 

30* 

YSUEl = YSlZE 

ISS02900 

31* 

ISK = 1 

ISS03000 

32* 

c determine Max and min for both axes 

ISS03100 

33* 

DO 10 Irl.NX 

ISS03200 

34* 

DO 10 U=1»NYS 

ISS03300 

35* 

DO 10 K=1»NY 

ISS03400 

36* 

IF (DP(I»U) .6T. FI(K)) 60 TO ll 

ISS03500 

37* 

10 CONTINUE 

ISS03600 

38* 

11 = NCHAR/6+1 

ISS03700 


196 


39* 

40« 

41* 

4a» 

43* 

44« 

45* 

464t 

47* 

48* 

49* 

bO* 

b24< 

b34c 

b4* 

bS« 

b64l 

57* 

b8« 

b9* 

bQ4( 

bl* 

b24t 

b3« 

b4« 

b5» 

b6« 

b7» 

b8« 

b9* 

70* 

71* 

72* 

73* 

74* 

75* 

76* 


PKINT 2004» (L.E6ENDU) »I=1»U) 

GO 10 800 
U CONTINUE 

XMX = X(NX-2) 

IF (XMAXIN .GT. 0.0) XMX = XMAXiN 

XNiAX = 0.0 

XKilN = 0.0 

YNAX =0.0 

YmIN = 0.0 

XUl) = XMX*SIN(YT*RAD) 

YXU) = XMX*C0S(YT*RAD) 

YPL = 1.0E8 
DO 12 N=1»NY 

12 YPL = AMIN1(YPL»F1(I^) ) 

11 = 0 

12 = 0 

DO 15 J=1»NYS 
DO 14 Isl»NX 

IF (DP(I»U) .LT, YPL) GO TO 14 
IF (II .GT. 0) GO TO 13 
II = 1 

13 12 s I 

14 CONTINUE 

IF (II .GT. 0) 60 TO 16 

15 CONTINUE 
lb J1 s J 

13 = 0 

14 = 0 

DO 19 J=1»NYS 
DO 18 lsl»NX 

IF (DP(I»NYS-o+ 1) .LT. YPL) GO TO 18 
IF (13 .GT. 0) GO TO 17 
13 z 1 

17 14 = I 

18 continue 

IF (13 .GT. 0) GO TO 20 

19 CONTINUE 

20 J2 = NYS-J+1 


ISS03800 

XSS03900 

ISS04000 

ISS04100 

1SS04200 

ISS04300 

ISS04400 

ISS04500 

ISS04600 

ISS04700 

ISS04800 

ISS04900 

ISS05000 

ISS05100 

ISS05200 

ISS05300 

ISS05400 

ISS05500 

ISS05600 

ISS05700 

ISS05800 

ISS05900 

ISS06000 

ISS06100 

ISS06200 

ISS06300 

ISS06400 

ISS06500 

ISS06600 

ISS06700 

ISS06800 

ISS06900 

ISS07000 

ISS07100 

ISS07200 

ISS07300 

ISS07400 

ISS07500 



77* 

IF (11 .Eii. 0) 11 = 1 

78* 

IF (12 .EQ. 0) 12 = NX-2 

79* 

IF (I3 .EQ. 0) l3 = 1 

80* 

If- (14 .EQ. 0) 14 = NX-2 

81* 

IF (12 ,GT, NX-2) I2 = NX-2 

az* 

IF (14 ,6T. NX-2) I4 = NX-2 

83* 

Y1 = Y(J1) 

84« 

Y2 = Y(J2) 

85« 

IF (YMAXIN ,LE. 0.0) GO To 21 

864( 

XPL = 1,0-YmAXIN/(2.0*XMX+XMX) 

H7* 

IF (XPL .GT. 1,0) XPL 1.0 

88« 

IF (XPL .LT. -1,0) XPL = -1.0 

89« 

XPL = ACOS(XPL)*RADl 

90* 

Y1 = YT+0,5*XPL 

91* 

Y2 = YT-0,5*XPL 

92* 

21 XU2) = X(I1)*SIN(Y1*PA0) 

93* 

YI(2) = X(Il)*COS(Yl*RAD) 

5 94» 

Xi(3) = X(I3)*S1N(Y2*RAD) 

95» 

YK3) = X(I3)*C0S(Y<i*RAD) 

96* 

Xl(4) = X(l2)*SlN(Yi*PAD) 

97* 

Yl(4) = X(I2)*C0S(Y1*RAD> 

98* 

XI(5) = X(I4)*S1N(Y2*RAD) 

99* 

YU5) = X(I4)*CoS(Y2*KA0) 

iOO* 

LO 22 I=l»5 

1U1« 

XMAX = AMAXKXMaX.XKD) 

XU2* 

YMAX = AMAXKYHAXfYKD) 

lOZ* 

XMIn = AMXNKXMlNrXKD ) 

104* 

22 YMIN = AMINl(YMIN»Yia>) 

1U5* 

c determine Plot scale 

Vif>* 

IF (SCL .LE, 0,0) GO TO 23 

i97* 

SCLX = 12,0/(SCL*,3048) 

108* 

SCLX = SCLX*RmSTIN 

1U9* 

SCLY = SCLX 

J.10« 

GO TO 24 


23 SCLX = XSIZ£1/(XMAX-XMIN) 

il2« 

SCLY = YSIZE1/(YMAX-YMIN) 

U3* 

SCLX = AMINl (SCLX. SCLY) 

114« 

SCLY = SCLX 
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Ub* 

24 

XPL = XSI2E1/SCLX 

ISS11400 

il6* 


IP (XPL-XMAX+XMIN) 25, 26 r 25 

ISS11500 

a17* 

2b 

XPL r (XPL-xMAX+XMlN)*0.b 

ISS11600 

il8« 


XMAX = XMAX + XPL 

ISS11700 

U9* 


XMIN = XMIN-XPL 

ISSU800 


26 

YPL = YSI2E1/SCLY 

ISS11900 

121* 


IF (YPL-YMAX+YMIN) 27, 28 » 27 

ISS12000 

4.22* 

27 

YPL = (YPL-YMAX+YMIN)*0,5 

ISS12100 

12^* 


YMAX = YMaX+YPL 

ISS12200 

124* 


YMIN = YMIN-YPL 

ISS12300 

125* 

28 

continue 

ISS12400 

126* 


HI = 12 

ISS12500 

127* 


CHAKF = 8 

ISS12900 

128* 


call SETMIVtO, 0,0,0) 

ISS13100 

129* 


call FRAMtViO) 

ISS13200 



CALL IDPL0T(XSI2E1+AUVi1+>:rM1,YSiZE1+YTM1+YBM1) 

ISS13300 

1^1* 

C 

DRAW AXES 

ISS13400 

1^2* 


CALL ILaXES ( 1 , TuABEL » TLABEL » NCTh » NCTH , LEGEND » NCHAR ) 

ISS13500 

1^3* 


XRIT = XMAX 

ISS13600 

134* 


XuFT = XMIN 

ISS13700 

135* 


YbOT = YMIN 

ISS13800 

136* 


YTOP = YMAX 

ISS13900 

137* 

bO 

continue 

ISS14000 

136* 


lines = 57 

ISS14100 

139* 


RMN = 1,0£9 

ISS14200 



TMN = YT 

ISS14300 

141* 


DO 710 N=1»NY 

ISS14400 

142* 


IF (N .eg. 1) GO TO 240 

ISS14500 

143* 


DO 230 I=1»NX 

ISS14600 

144* 


KOUT = 4*i»4+IRtC 

IbSl4700 

145* 


CALL 1NT0UT(DP»K0UT»NYS,1,41»1) 

1SS14800 

146* 

230 

continue 

ISS14900 

147* 

240 

continue 

ISS15000 

146* 


Call nmbrs(fi (N) »num,nc) 

ISS15100 

149* 


DO 400 I=lr4 

ISS15200 

IbO* 

400 

Npp(l) = 0 

ISS15300 

Ibl* 


NP = 3 

ISS15400 

lb2* 


L = 0 

ISS15500 
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ib3+ 

lb5* 

ib6* 

lb7* 

IbS* 

ib9« 

160« 

Ibl^c 

ib2* 

lb3* 

lb4+ 

ibb* 

lb6* 

ib7» 

lb8* 

ib9* 

l70* 

l/l* 

172* 

173* 

174* 

175* 

I7b* 

ni^ 

i76* 

179* 

ibO* 

xbl+ 

lti2* 

xti3* 

iti4* 

lb5^ 

iUb* 

lb7* 

ibb^ 

ib9* 

lyo* 


K = 1 

c cmLc points Where isopleths cross axes 

DO 470 I=i»NX 
Jb z C 

00 430 J=<i»NYS 

IF lDP(I»w)-l) ,LE. FKf;) .ANO.FI(N) .LE. DP(I»J)) GO TO 4lO 
IF (DP(I»0-1) .GE, FI (N) #AND»FI (N) ,GE, DP(I»J)) GO TO 410 
GO 10 430 
410 Ob z 1 
L = L+1 
NF z NP+l 
Yb = Y(J) 

IF (ABS(Y(J-1)-Y2) iUT, 160#0) gO TO 420 
Y2 z 360.0-AeSO (0-i)-V2)+Y(J-l) 

420 YY(nP) z XYTERP(YI*J"1) »Y2rDP(I»J-l)»DP(lMj)»FI(N)) 

XX(NP) z X(I) 

IF (NP .GE. 245) GO TO 475 
430 CONTINUE 

IF (UB ,E0, 1) GO TO *+40 
IF 4L .eg* 0) GO Tu 440 
NPP(K) z L 
L z 0 
K z K+1 

IF (K ’.6T. 2) GO TO 475 
440 IF ll .EO. NX) gO TO 470 
DO 460 J=1»NYS 

IF (DP(I»U) .LE, Fl(N).AriU.FKN) ,LE. DP(I+1»J)) 60 TO 450 
IF (DP(I»U) .GE. FilN) .AND.FIlN) ,6E, DPU + lfU)) GO TO 450 
60 10 460 
450 L = L+1 
NP = NP+l 

XX(nP) z XYTEKPUU) »X(I + 1) »DP (1» J) »DP(I+1» J) »Fi (N) ) 

YY((mP) z Y(^) 

IF (NP ,Gt, 2*+5) GO TO 475 
4o0 CONIINUE 
470 CONTINUE 
475 CONIINUE 
NP z NP-3 
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191* 


NPP(K) = L 

192* 

480 

IP INPP(K) ,6T. 1) 60 TO 490 

193* 


K = K-1 

194+ 


IP (K .LE, U) 60 TO 710 

195* 


60 TO 480 

i96» 

490 

COI^TlwUE 

197* 

c 

determine if closed curve OR N0» KB(U)=0 IS YES# 

198# 


IPl = 3 

i99* 


KC = 0 

2U0* 


Do *t96 L=1»K 

201» 


Kb(L) = 0 

tioa* 


MP = NPP(L) 

203^ 


J2 = 1 

2U44< 


DO 495 I2=l#2 

205» 


I = 0 

2U6« 

491 

I = I + l 

207* 


IP II .GT. MP) 60 TO 495 

2U8# 


IP (YY(I+IPi)-Y(U2) ) 491»492#49l 

209# 

492 

XI = 1.0E8 

mo* 


DO 493 J=i»MP 

mi* 


IP (J+IPl .EQ, i+IPl) 60 TO 493 

2l2* 


Y1 = ABS(Y(j2)-YY(J+IP1)) 

ms* 


IP (Y1 ,6T. 180.0) Y1 = 360.0-Yl 

m^* 


IP lYl ,GE. XI) 60 TO 493 

mb* 


XI = Y1 

me* 


U1 = J 

mi* 

493 

CONTINUE 

218« 


IP (XX(I + IPl) .GT. XX(J1+IPD) GO TO 494 

219« 


KC - KC+3 

mo* 


K6(L) = Kb(U+3 

mi* 


60 TO 491 

mz* 

494 

Kb(u) = Kb(L)+l 

223* 


KC = KC+1 

«:24* 


60 TO 491 

225* 

495 

J2 s NYS 

226* 


iPl = IP1+NPP(L) 

mi* 

496 

CONTINUE 

me* 

497 

IP (KC ,EO. 0) GO TO 503 


1SSX9400 
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J = 1 

498 IF (KB(J) .WE. 0) &0 TO 499 
FIRST CLOSEu CUKVt 

IF tJ+1 .6T, K) GO TO 503 
IF (KB(J+1) .EQ. 0) GO TO 502 
CAN SECOND CURVE bE CLOSED 

IF (KB(J+X),E0.4.0R.Kt)(J+X).EQ.5.0R.Kb(J+I).EQ.7) KB(J+X) = 0 
GO TO 502 

499 IF (U+1 .OT. K) GO TO 500 

IF (KB(J+X) .WE. 0) 60 TO 501 

SECOND curve CLOSED 

CAN FIRST CURVE BE CLOSED 

500 IF (KB(J) .E0.4.0R.KB(wI) ,EQ.5.0R.KB(J) .EQ.7) KB(J) = 0 
IF (K .EQ. l.MND.Kb(X) .EG. 6) kBU) = 0 

60 TO 502 

Can two curves be UOIWED INTO One closed CURVE 
BOX IF (KB(J) .WE. 2.aNU.KB(J) .NE. 4) GO TO 502 

IF (Kb(J+X) .WE. 6 .AND.KB(u+X) ,NE. 4) 60 TO 502 
DOIW TWO CURVES INTO ONE CLOSED CURVE 
NHP(D) = WPP(J)+NPP(J+1) 

Kb(u) = 0 
K = K-1 
J = J+X 

IF (J .GT. K) 60 TO 503 
Kb(u) " Kb(b+1) 

NPP(J) = NPp(U+X) 

IF (U+l .GT. 3) GO TO 498 
Kb(u+1) = K6 (j+2) 

WPP(J+1) = WPP(J+2) 

60 TO 498 

502 J = J+2 

IF (o .LE. K) GO TO 498 

503 continue 
IPX = 3 

LOOP over SePERATE curves of same isopleth 

DO 700 L=X»K 
NP = NPP(L) 

Shift points to staRt of array 
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1 = 0 

dba* OiF = l,0t.20 

00 520 J=i»iNiP 
270* I = I+l 

271* Xa(I) = XX(J+iPl) 

272* YY(i) = YY(j+iPl) 

273* IF (XX(I) *6E. DIF) 00 TO 520 

^74t OiF = XXU) 

275» YRM s YY(I) 

276» 520 ^continue • 

277# IF (L .GT, l*0R,Kb(L) ,NE. 0) 

278* IF (OIF *UE. RMN) eO TO 525 

279* NP = NP+1 

2B0* D'iF = 0,75*RMN 

2bl# YKM = TMN 

2B2» XX(,mP) = DiF 

2B3* YY(ImP) = YKM 

cB4^ eo TO 530 

kbb* 525 RNiN = DIF 

2B6* Tt^iN = YRM 

2b7* 530 CONTINUE 

2b6« 

2b9l= 

290* 

291* 

292* 

293* 

294* 

295+ 

296» 

297* 

298* 

299# 

OU0« 

301:^ 

302* 

3U3:(c 

3U4« 


I5S27000 

ISS271C0 

ISS27200 

ISS27300 

ISS27400 

ISS27500 

ISS27600 

ISS27700 

ISS27800 

ISS27900 

GO TO 530 1SS2&000 

I5S28100 
ISS26200 
15528300 
I5S28400 
ISS28500 
I5S28600 
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I5S30500 
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C DETERMINE CENTRAL POInT OF CURVE AND CONVERT POINTS TO SYSTEM 
C relative TO CENTRAL POINT 

Call CALC5(xX»YY»NP»RAD»RADl*X5HFT»YSHFT»O.O»O.0r0»K8(U »YT»X,NX) 
C FiNu START POINT OF CURVE 

YRM s YT 

MP = 0 

IF (KB(L) .NE, 0) GO TO 560 
YRM = YT+180,0 

c determine First point of closed curve 

550 IF (YRM ,LE. YY(NP)) 60 To 551 
YRM = YRM-360.0 

GO TO 550 

551 IF (YRM .GE. YYU)) GO TO 552 
YnM = YRM+3fa0.0 

60 TO 551 

552 XI = YRM+ 180.0 
DU 553 1=1 »NP 
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3U5* 

0U7* 

009 * 

ilZ* 

513* 

314* 

315* 

316* 

317* 

316* 

319* 

360* 

361* 

362* 

363* 

364* 

365* 

366* 

367* 

368* 

369* 

330* 

331* 

332* 

333* 

334* 

335* 

336* 

337* 

336* 

339* 

340* 

341* 

342* 


IF (YY(I) .LT. YRM) go to 553 
MP = I-l 
GO TO 555 

553 continue 

554 XI = YRM-180,0 

555 CONTINUE 
GO TO 570 

560 CONTINUE 

c determine First point of opened curve 
DIF = -1.0E9 
DO 561 I=6»NP 
Y1 = ABS(YY(I)-YYa-l) ) 

IF (Y1 ,GT, 160,0) Y1 = 360.0-Yl 
IF (Y1 ,LT. DIF) GO TO 561 
DIF = Y1 
MP = I-l 

561 CONTINUE 

Y1 = ABS(YY(NP)-YY(1)) 

IF (Y1 ,GT, 160,0) Yl = 360,0-Yl 
IF (Yl ,LT, DIF) 60 TO 570 
MP = 0 

570 CONTINUE 

IF (MP ,LE, 0) GO TO 594 
DO 572 J=1»MP 
XPL = XXU) 

YPL = YY(1) 

DO 571 I=6»NP 
XX(I-l) = XX(I) 

571 YY(I-l) = YY(I) 

XX (NP) = XPL 
YY(nP) = YPl 

572 CONTINUE 

c make sure In ascending order 

Yl S YY(1) 

DO 593 I=6»NP 
OIF = ABS(YY(I)-Y1) 

IF (DIF .GT, 180,0) DIF = 360,0-DIF 
Yl = YY(I) 
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ii43^ 


593 

YYU) = YY(I-1)+DIF 

1SS34600 

344* 


594 

Continue 

ISS34700 

545* 



IF (KB(L) .NE. 0) GO TO 595 

ISS34800 

34641 



NP = NP+1 

ISS34900 

347* 



XX(NP) = XX< 1 ) 

ISS35000 

346* 



DiF = ABS(YY(i)-YY(NP-l) ) 

ISS35100 

349* 



IF (OIF .GT, 180,0) DIF = 360.0-OIF 

1SS35200 

3&0* 



YY(NP) = YY(NP- 1 )+dIF 

ISS35300 

3bl4< 


595 

CONTINUE 

1SS35400 

3b2« 



IF (NP ,GT, 245) NP = 245 

ISS35500 

3b3* 



IF (KB(U .NE, 0) Xl = 0.54 c(YY(1)+YY(NP)) 

ISS35600 

3b4« 



NPI = NP 

ISS35700 

3b5* 



I£R = 1 

ISS35800 

3b64i 



DO 600 I =1»NP 

ISS35900 

3b7* 


0 ^ 

0 

0 

XX(I) = ALOG(XXd)) 

I5S36000 

3b8* 



IF (NP ,LT. 6 ) GO TO 650 

ISS36100 

3b9* 



IF (JSW ,NE, 0 ) GO TO 650 

ISS36200 

3&0>^ 

C 


CALC SPLINE COEFFICIENTS WITH RaNGE AS AMPLITUDE AND ANGLE 

AS THE IS536300 

3614c 

C 


ABSCISSA 

ISS36400 

3624c 



call SPLINE (YY,XXrDR»DR(l»2)»0R(l» 3) »DR ( 1 r 4) »NP, lER ) 

ISS36500 

363* 



IF (lER ,EQ, 1) GO TO 650 

ISS36600 

3644c 



XPL = (YY(NP)-YY (1) )/200.0 

ISS36700 

3654c 



XPL 2 = XPL*0,1 

ISS36800 

3664c 



XPl = XPL 

ISS36900 

3674c 



0 = 0 

ISS37000 

3684 c 



M = 1 

ISS37100 

3694c 



YPL = YYCD-XPl 

ISS37200 

3704c 


631 

YPL = YPL+XPI 

ISS37300 

3714c 



IF (YPL ,LE, Xl-2.0*XPL) GO TO 632 

ISS37400 

3724c 



XPl = XPL2 

ISS37500 

3734 c 



IF (YPL ,GE, X1+2.0*XPL) XPl = XPL 

ISS37600 

3744 c 


632 

IF (YPL ,LT, YY(M+D) GO TO 634 

ISS37700 

3754 . 


633 

M = M+1 

1SS37800 

3764c 



IF (M ,GE, NP) GO TO 670 

ISS37900 

377* 



IF (YPL ,GE, YY(M+D) go to 633 

ISS38000 

3784c 


634 

Y1 = YPL^YY(M) 

ISS38100 

3794 c 

C 


CALC RANGE AT YPL 

ISS38200 

360* 



Y 1 = XX(M)+Y1*(DR(M»2) + (YPL-YY(M+1) )4c(2,4cDR(M,3)+DR(M+1»3)+DR(M»1)ISS38300 
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1*Y1)*, 16666067) 


ISS38400 

^B2* 



J — J+i 


ISS38500 




DK(jr5) = EXP(Yl) 


XSS38600 

5b4* 



DR(sJr6) = YPL 


ISS38700 

305* 



IF (d .6E, 244) GO TO 670 


ISS36800 

306« 



GO TO 631 


ISS38900 

307* 


650 

DO 660 M=1»NP 


ISS39000 

306« 



DR(M»5) = EXP(XX(M)) 


ISS39100 

3tt9» 


660 

DR(Ni»6) = YY(M) 


ISS39200 

390* 



NPI = NP 


ISS39300 

391* 


670 

MP s 1 


ISS39400 

392* 



IF (lER .EQ. 0) NP = d 


ISS39500 

393* 



DO 675 I=l»NPi 


ISS39600 

394* 


675 

XX(i) = EXP(XX(D) 


ISS39700 

395* 



IF (KB(U .NE. 0) 60 TO 680 


ISS39800 

396* 



NP = NP+1 


ISS39900 

397* 



DR(NP»5) s LR(1»5) 


1SS40000 

398* 



DK(nP» 6) = dR(lr6) 


ISS40100 

399* 


660 

continue 


ISS40200 

4U04C 

C 


CONVERT PLOT POINTS BACK TO SYSTEM RELATIVE 

TO launch site 

ISS40300 

401* 



Call calcs (DR(lf5) »DR(1,6) ,NP»RaD»RADI»X1»Y1 

»XSHFT»YSHFT»2»KB(L)» 

ISS40400 

402* 


1YT»X»NX) 


ISS40500 

403« 

C 


PLOT CURVE 


ISS40600 

4U4« 

. 


IF (ISW3 .EO. 2) 60 TO 694 


ISS40700 

4U5« 



M = NPI 


ISS40800 

406* 

C 


CONVERT PRINT POINTS BACK TO SYSTEM RELATIVE 

TO LAUNCH SITE 

ISS40900 

407* 



call CALCS(XXrYY»M»KAU»RADI»Xl»Yl,XSHFT»YSHFT»l,Ka(L) fYT»X»NX) 

ISS41000 

4U64> 



IF (LINES .6T, 52) 60 TO 686 


ISS4U00 

409* 



WRITE (6»2000) FI (N) » (KLINE(U) »d=l »NCV) 


ISS41200 

4104> 



WRITE (6»2003) 


ISS41300 

411* 



lines = LINES+3 


ISS41400 

412* 



60 TO 687 


ISS41500 

413* 


686 lines = 57 


1SS41600 

414* 


667 

continue 


ISS41700 

415* 



Ml = -5 


ISS41800 

416* 


686 

Ml = Ml+6 


ISS41900 

417* 



IF (Ml .6T, M) 60 TO 692 


ISS42000 

4l8* 



M2 = Ml+5 


ISS42100 
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419* 


IF iM2 ,GT. M) M2 s M 

ISS42200 



LlNtS = LiNtS+1 

ISS42300 



IF (LINES ♦LT. 57) GO TO 691 

ISS42400 



IF (JM .6T. 1) 60 TO 689 

ISS42500 



CAUL PRTTTL (NvvD » LINUS » LEGEND » 0 . 0 » 0 , 0 » 2B » 2T ) 

ISS42600 

424* 


GO TO 690 

ISS42700 

425« 

689 

call PPTTTL ( Nad » LINES » LEGEND ► DECAY » LAMBDA » ZB » ZT ) 

ISS42800 

426* 

690 

WHITE (6»2000) F I (N) » (KLINE ( J) » J=1 » NCV ) 

ISS42900 

427* 


write (6»2001) 

ISS43000 

428« 


lines = lines +7 

ISS43100 

429+ 

691 

write (6»2002) (XX(J) »YY(J) , J=MlfM2) 

ISS43200 

440* 


GO TO 688 

ISS43300 

4il* 

692 

C(>NTINUE 

ISS43400 

4i2# 

694 

continue 

ISS43500 

433* 


IF (ISW3 .Eg, 1) GO TO 695 

ISS43600 

434* 

C 

PuOT CURVE 

ISS43700 

435* 


Call ilploT(dr(mp»5) »or(mp,6) ,np,i,dr) 

ISS43800 

436* 

695 

continue 

ISS43900 

437* 


IPl = IPH-NPP(L) 

ISS44000 

438* 

700 

CONTINUE 

ISS44100 

439* 

710 

continue 

ISS44200 

440* 


IF (ISW3 .EG, 1) GO TO 800 

ISS44300 

441* 


XPL = -XMIN*SCLX+XLMl-0.b*HT 

ISS44400 

442* 


YPL = -YM1N*SCLY+YbM1-0.5*hT 

ISS44500 

443* 


Call PRlNTV(l,lH*f IFIX(XPL) » IFIX(YPL) ) 

ISS44700 

444* 

800 

CONTINUE 

ISS44900 

445* 


Return 

ISS45000 

446* 

2000 

format (lH0,40X,22h^-*-* ISOPLETH LEVEL =»F9.3f2H» »9 a6) 

ISS45100 

447* 

2001 

FoRMAT(lH0fb(19H RANGE AZIMjTH )/1X*6(19H (METERS) BEARING 

)/ISS45200 

448* 

llX»6(10X»9H(DtGREt.S) )/lX»19(6h ) ) 

ISS45300 

449* 

2002 

format (1X»6(F10.3,F8,3,1X) ) 

ISS45400 

4b0* 

2003 

format 0 

ISS45500 

4bl* 

2004 

format (*0 *** ISOPLE7HS OUT OF RANGE FOR ♦ » 16A6/ (IX r21A6) ) 

ISS45600 

4b2* 


END 

ISS45700 
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!♦ 

Z* 

2* 


subkoutinc lSsopt, Version 5, revision 3 

SuoKOUT iNt LSSOPT ( X » Y » NX n. Y » F I » VLABEL » LEGEND » NC V r NCHAR ) 

LSSOOlOO 

4^ 

C 

lb iSW z 2 uOO-LObf IR iSift = 1 linear 

LSS00200 

5* 


common /PlTlLO/ IS^»XMAX0N,YMAXjN,XCl2EfYClZE 

LSS00300 

6* 


CuMmON /BNDS/ XRIl rXLFT»YB0T»YT0P»XPL,YPL 

LSS00400 

7* 


dimension X(1) ,YU) »FX(1) 

LSS00500 

&* 


common /IlALPh/LCRIT( 10) »IBLANK,ISTAR»lPl»IP2rIp3,HLABEL(5) rNCH 

LSS00600 

9* 


common /XYXyPT/ YP(41) ,XP(41) »A(4i) »Bt41) »C(41) ,D(41) ,Xi(41) »YI(41LSS00700 

104c 

1) rNUM(3) »NC 

LSS00800 

11* 


common /IlPlTS/ XMA^»XMIN,YMAX»YMlN»XLMl»YBMl»HT»CHARF»SCLX»SCLYf 

LSS00900 

IZ* 

IXblZElfYSUfcil 

LSSOIOOO 

12* 


data DlSPrXLN,YbN»XRN,YTN/3.0»62.»102.,24.,22./ 

LSS01200 

m* 


XLMl = XLN 

LSS0X300 

lb* 


YbMi = YBN 

LSS01400 

lb* 


XKMl = XRN 

LSS01500 

17* 


YTMi = YTn 

LSS01600 

la* 


XbUEl = XCiZE 

LSSC1700 

19* 


YblZEl = YCIZE 

LSS01800 

^0* 

C 

determine Max and min for both axes 

LSS01900 

Zl* 


Y1 0.0 

LSS02000 

zz* 


J1 = 0 

LSS02100 

23* 


u2 = 0 

LSS02200 

24* 


Y2 = 1.0E20 

LSS02300 

25* 


J3 =; 0 

LSS02400 

2b* 


DO 50 I=1»NX 

LSS02500 

27* 


IP lY(I) .LE. C.O) go to 40 

LSS02600 

2d* 


IF tJl ,6T. 0) GO TO 30 

LSS02700 

29* 


J1 = I 

LSS02800 

30* 


GO TO 31 

LSS02900 

31* 

30 

jZ z I 

LSS03000 

32* 

31 

Ir (Y(I) .67. Yl) Yl = Y(I) 

LSS03100 

33* 


IF (Y(I) .LT. Y2) Y2 = Y(i) 

LSS03200 

34* 


GO TO 50 

LSS03300 

35* 

*+0 

J3 s 1 

LSS03400 

36* 

50 

CONI INUE 

LS503500 

37 * 


IF (ISw .EQ. 2) 60 TO 60 

LSS03600 

38 * 


IF iJ3 .EO. 1) Y2 = 0.0 

LSSC3700 
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i9* 


J1 = 1 

LSS03800 

*»0* 


— NX 

LSS03900 

‘tl* 


call MAXM1N(XiMAXON,X(u1) »XMAX,XmIN»X(J 2) rX(Jl) »1) 

LSS04000 



call MAXMlN(YMAXJNfY2»YMAXrYMIN,Yl»Y2»l) 

LSS04100 



GO TO 80 

LSS04200 

44* 

60 

II- (Y1 .Lt. 0,0) GO TO 230 

LSS04300 

45* 

61 

IK (X(J1) *GT, U.O) go to 70 

LSS04400 

46* 


vJl — l1*1 

LSS04500 

47* 


Gw TO 61 

LSS04600 

48* 

70 

XPL = 10.0**X(J1) 

LSS04700 

49* 


YFL = 10.0**X(02) 

LSS04800 

t>0* 


call MAXMIN ( XMAX JN , XPL t XMAX ♦ XMIn » YPL » XPL f 2 ) 

LSS04900 

t>l* 


call MAXMlN(YMAXJN,Y2fYMAXrYMIN,Yl,Y2»2) 

LSS05000 

b2* 

80 

continue 

LSS05100 

t>3* 

C 

dltermine Plot scale 

LSS05200 

b4* 

90 

IK (ISW .£Q. 2) go to 100 

LSS05300 

b5* 


SCLX = XSIZe1/(XMmX-XMIN) 

LSS06400 

b6« 


SCLY = YSXZE1/(YMAX-Yiv1IN) 

LSS05500 

b7* 


GO TO 110 

LSSC5600 

b8* 

100 

SCLX = XSI2eI/(aLOG10(XMAX)-ALOg1O(XMIN)) 

LSS05700 

b9* 


SCLY = YS1Ze1/(ALOG10(YMAX)-ALOg10(YMIN) ) 

LSS05800 

faO* 

110 

continue 

LSS05900 

bl« 


IF (ISw ,EQ. 2) GO TO 115 

LSS06000 

62* 


XuFT = XMIN 

LSS06100 

63* 


XMt z XMAX 

LSS06200 

b4* 


YTOP z YMAX 

LSS06300 

b5* 


YdOT = YMIN 

LSS06400 

bb* 


GO TO 116 

LSS06500 

67* 

115 

continue 

LSS06600 

66* 


XLFT = ALOGIO(XmIN) 

LSS06700 

69* 


XKIT = ALOGlOlXMAX) 

LSS06800 

70* 


YlOp z ALOGlOtYMAX) 

LSS06900 

7i* 


YbOr = ALOGIOIYMIN) 

LSS07000 

72* 

116 

continue 

LSS07100 

73* 


call SETMlV(0»0,0»0) 

LSS07200 

74* 


call FRAMEV(O) 

LSS07300 

75* 


HI z 12 

LSS07500 

76* 


CHAKF = 8 

LSS07900 



77* 

C 



LSS08100 

7B* 

C 


DRAW AXES 

LSS08200 

79* 



CALL ILaX£S (I Svv , VLa8EL t HLaBEL r N c V r NCH r LEGEND » NCHAK ) 

LSS08300 

BO* 

C 



LSS08400 

til* 

C 


PLOT CURVE 

LSS08500 

B2* 



NC - J2*>J141 

LSSb6600 

b3* 



IP (NC .LE. 0) 60 TO 220 

LSS08700 

b4* 



IP (ISw .NE. 2) GO TO 121 

LSS08B00 

b5* 



DO 120 I=JlrJ2 

LSS08900 

b6* 



Y(I) = ALOG10(Y(D) 

LSS09000 

87* 


1^0 

continue 

LSS09100 

88* 


121 

continue 

LSS09200 

89* 



IP (NC .LT. 3) GO TO 125 

LSS09300 

90* 



CALL SPLINE (X( Ji) ,Y(J1) »A,B»C»D»NCrIEK) 

LSS09400 

91* 



IF (lER .EQ. 1) GO TO 125 

LSS09500 

92* 



DA = (X(U2)-X(J1) )/82.0 

LSS09600 

93* 



XPL = X(J1)-DX 

LSS09700 

g 94* 



N = 0 

LSS09B00 

w 95* 



I = 1 

LSS09900 

96* 


123 

XPL = XPL+DX 

LSSIOOOO 

97* 



IP (XPL ,LT, X(Ul + m GO TO 124 

LSSlOlOO 

9B* 



I = 1+1 

LSS10200 

99* 


124 

IP (I+Jl .GT. J2,0R.N ,GE, 62) GO TO 127 

LSS10300 

100* 



N = N+1 

LSS10400 

1U1« 



YPL = XPL-X(J1+I-1) 

LSS10500 

102* 



YP(N) = Y(J1+I-1)+yPL*(B(I)+(XPL-X(J1+1) )*{2.0*C(I)+C(I+1)+A(I)* 

LSS10600 

103* 


IYPL)*. 1666667) 

LSS10700 

104* 



XI (N) = XPL 

LSSlOBOO 

105* 



60 TO 123 

LSS10900 

106* 


125 

DO 126 I=1»NC 

LSSllOOO 

107* 



XKI) = X(Jl+l-l) 

LSSlllOO 

lOB* 


1^& 

YP(I) = Y(Jl+I-l) 

LSS11200 

109* 



N 5 NC 

LSS11300 

110* 


127 

CONTINUE 

LSS11400 

111* 



CALu ILPL0T(Xl»YPrN»2»A) 

LSS11500 

112* 



IF (NY ,EQ* O.OR.NY .EQ. 9) GO TO 220 

LSS11600 

113* 



XINl = 8 

LSSllBOO 

1.14* 



IF (ISW .EQ, 2) YMIN = ALOGIO(YmIN) 

LSS11900 



DO 210 I=1»WY 

LSS12000 


IH (ISVv ,t;Q, 2) GO TO 130 

LSS12100 


Yb = (FIU)-Y)V|IN)*SCLY+YBM1 

LSS12200 


GO TO 131 

LSS12300 

150 

Yb = (ALOGlO(FMI) )-Yi''UN)*SCLY+YBMl 

L6S12400 

151 

IF (YS ,LT, YbMl) GO TO 210 

LSS12500 


IF lYS .ST. YBNU+TSiZtl) GO TO 210 

LSS12600 


CALu NMBRS(FKI) »NUM»NC) 

LSS12700 


XI z XLMl-XlNC 

LSS12800 


X2 z XLMl+XsiZi£l-FLSAT(NC)*CHARF-DISP 

LSS12900 


*16 z 2 

LSS13000 


XPL z XLWi 

LSS13100 

140 

XI z Xl+XINc 

LSS13200 


IF (XI .St. X2) XI = X2 

LSS13300 


IF (Ib .E^. 3) GO TO 150 

LSS13400 


CALL LINE2V(IFIX(XPL) .IFIX(YS) »IFIX(X1-XPL) .0) 

LSS13700 

150 

IF (XI .Gt. X2) GO TO 170 

LSS13800 


XPL = XI 

LSS13900 


IF (IB ,EQ. 2) GO TO 160 

LSS14000 


Ib z 2 

LSS14100 


GO TO 140 

LSS14200 

160 

Ib z 3 

LSS14300 


Go TO 140 

LSS14400 

170 

call PRlNrV(NC»NUM,iFIX(X2+XlNC) »IFIX(YS-4.0) ) 

LSS14600 

210 

continue 

LSS14700 

220 

continue 

LbSl4800 

250 

RLTURN 

LSS14900 


End 

LSS15000 
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1* 

2 * 

5* 

4« 

5« 

6 * 

?♦ 

B* 

9* 

10 * 

11 * 

12 * 

13* 

m* 

15* 

16* 

17* 

18* 

19* 

dO* 

21 * 

22 * 

23* 

24* 

25* 

26* 

27* 

28* 

29* 

30* 

31* 

32* 

33* 

34* 

35* 

36* 

37* 

38* 


SUBROUTINE iLAXESf VERSION 5, REVISION 3 

subroutine ILAXES (iSW , VLABEL » HL aBEL » NCV » NCH » LEGENd » NCHAR ) 

COMMON /ILPLTS/ XMAX » XMIN , YMAX f YMIN » XLMl f YBMl » HT » CHARF » SCLX » SCLY » 
IXSUElfYSIZEl 

DIMENSION NUM(3) ,LEGEND(1) rVLABEL(l) rHLABELd) 

c isw = 1 linear axes 

C ISW = 2 LOG-LOG AXE& 

data TIC1/8.0/,TIC2/4,0/»DISP/3.0/ 
data XINCMN/14,6/ 

IF (ISW ,NE, 2) GO TO 40 
XST = ALOGlg(XMlN) 

XINc = 1.0 
K = XST 

Xp - R 

IF IXST-XP) 20r60i20 

20 IF (XST) 21|21.30 

21 K = K-1 
GO TO 60 

30 K z K+1 
60 TO 60 
40 continue 

c determine increment between minor tic marks 

XINc = (XmAX-XMIN)/(XSIZE1*10,0) 

IF (XINC*SCLX .LT, XINCMN) XINC = XINCMN/SCLX 
J z ALOGIO(XINC) 

K z XINC*10,0**(-J) 

XINc z K*10**u 
XST z O.O 

50 IF (XST .LE, XMiN) GO TO 60 
XST z XST-10.0*XINC 
GO TO 50 

60 continue 

Call LINE2V(IFIX(XLM1) rlFlX(YBMl) r0»IFIX(YSIZEl) ) 

call LINE2V(IFIX(XLM1) .IFIX(YbMi+YSIZ£1) .IFIX(XSIZEI) »0) 

call LINE2V(IFIX(XLM1+XSIZE1) »IFIX(YBM1+YSIZE1) »0.-IFIX(YSI2E1) ) 

Call LINE2V(IFIX(XLM1+XSIZE1) »IFIX(YBM1) .-IFIX(XSIZEl) »0) 

C PLOT aNO label X AX^S 


ILAOOIOO 

ILA00200 

ILA00300 

ILA00400 

1LA00500 

ILA00600 

ILA00800 

ILAOIOOO 

ILAOllOO 

ILA01200 

ILA01300 

ILA01400 

ILA01500 

ILA01600 

ILA01700 

ILA01800 

ILA01900 

ILA02000 

ILA02100 

ILA02200 

ILA02300 

ILA02400 

ILA02500 

ILA02600 

ILA02700 

ILA02800 

ILA02900 

ILA03000 

ILA03100 

ILA03200 

ILA03300 

ILA03900 

1LA04000 

ILA04100 

ILA04200 

ILA04300 
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i9* 

41* 

42* 

43* 

44» 

45* 

46* 

47* 

48* 

49* 

bO* 

bl* 

b2« 

b3>t> 

b4* 

b5# 

b6« 

b7* 

b8« 

b9» 

bO« 

bl* 

b2« 

b3« 

64* 

b5* 

b6* 

b7» 

b8« 

b9* 

70* 

71* 

72* 

73* 

74* 

75* 

76* 


YP = Y3M1 
J = 1 


IUA04400 

IUA04500 


DO 150 I=l»2 IUA04600 

IF (ISIH »EQ, 2) SO TO 70 II.A04700 

X = XST-XINC ILA04800 

SO TO 80 ILA04900 

70 U = K -1 IUA05000 

X = 9.0 ILA05100 

80 18 = 9 ZLA05200 

90 X = X+XINC IUA05300 

I8 = 18+1 IUA05400 

IF (IB ,LE. 10) SO TO 95 ILA05500 

It> = 1 ILA05600 


IF (ISW .NE, 2) SO TO 95 
18 = 2 
L = L+1 
X = 2,0 
95 continue 

IF (IS^ .£0, 2) SO TO 100 
XP = (X-XMIN)*SCLX+XUM1 
SO TO 105 

100 XP = (ALOS10(X*10,0**U)~XST)*SCLX+XLM1 
105 IF (XP ,LT, XLMl) sO TO 90 

IF (XP .ST* XLMI+XSIZEI) 60 TO 140 

110 continue 

IF (IB *UT, 10) 60 TO 130 

call LINE2V(IFIX(XP) »IFIX(YP) »0,IFIX(TICD*J) 

IF (ISW *£Q, 2) 60 TO 120 
IB = 0 

IF (J *LT. 0) SO TO 140 
call NMbRS(X»NUM*NCHT) 

call PRINTV(NCHT»NUM»IFIX(XP-.5*FL0AT(NCHT)*CHARF) *IFIX(YP- 
1 )) 

60 TO 140 
120 X = L+1 
IB = 1 

IF (wl *LT, 0) Su TO 125 

call PRINTV(2, »10»»IFIX(XP^2.0*CHARF) »IFIX(YP-HT-3.0*DISP)) 


ILA05700 

ILA05800 

ILA05900 

1LA06000 

ILA06100 

ILA06200 

ILA06300 

ILA06400 

ILA06500 

ILA06600 

ILA06700 

ILA06800 

ILA07100 

ILA07300 

1LA07400 

ILA07500 

ILA07600 

ILA07700 

HT-DISPILA07900 

ILA08000 

ILA08100 

ILA08200 

ILA08300 

ILA08400 

ILA06700 
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77* 

CALL LABLV(AfIFlX(XP)»IFlX(YP-HT-DISP) ,2rl»2) 

ILA06800 

76* 

125 CONTINUE 

ILA08900 

79* 

X = 1.0 

ILA09000 


L = L+1 

ILA09100 

til* 

eo TO 140 

ILA09200 

tiZ* 

130 CALL LlNE2V(lFlX(XP)»lFIX(YP)rO.IFIX(TIC2)*J) 

ILA09400 

ti3* 

140 CONTINUE 

ILA09500 


IF (XP ,LT, XLMI+XSIZEI) GO TO 90 

ILA09600 

tiS* 

YP = YBMI+YSIZEI 

ILA09700 

tib* 

U = -1 

ILA09800 

ti7* 

150 continue 

ILA09900 

ti8* 

C PLOT and label Y AXES 

ILAIOOOO 

ti9* 

IF {ISW .NE, 2) GO TO 154 

ILAIOIOO 

90* 

XST = ALOGIO(YMIN) 

ILA10200 

91* 

XiNc = 1.0 

ILA10300 

92* 

K = XST 

ILA10400 

9^* 

XP = K 

ILA10500 

94* 

IF (XST-XP) 151rl56»15l 

ILA1C600 

95* 

151 IF (XST) 152»152»153 

ILA10700 

9b* 

152 K = K-1 

ILA10800 

97* 

GO TO 156 

ILA10900 

98* 

153 K = K+1 

ILAllOOO 

99* 

GO TO 156 

ILAlllOO 


154 XiNc = (YMAX-YM1N)/(YSIZE1*10,0) 

ILA11200 

iOl* 

IF (XiNC*SClY .lT. XINCMN) XINC = XINCMN/SCLY 

ILA11300 

102* 

0 = ALOGlO(XINC) 

ILA11400 

103* 

K z XINC*10,0**(«J) 

ILA11500 

104* 

XiNc z K*10**J 

ILA11600 

105* 

XST z 0,0 

ILA11700 

106* 

155 IF (XST ,LE, YMlN) GO TO 156 

ILA11800 

107* 

XST z XST-XiNC*10.0 

ILA11900 

108* 

GO TO 155 

ILA12000 

109* 

156 CONTINUE 

1LA12100 

llO* 

XP = XLMl 

ILA12200 

111* 

XD = 5,0 

ILA12300 

112* 

IF (ISW ,£Q, 2) XD = 4.0 

ILA12400 

113* 

XD z XP-XD*CHARF-DlSP 

ILA12500 

114* 

D z 1 

ILA12600 
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iX5* 


DU 250 I=lr2 

ILA12700 



IF (ISW .£Q. 2) GO TO 160 

ILA12800 

il7* 


X - XST-XlNc 

ILA12900 

il6« 


GU TO 170 

ILA13000 

il9* 

160 

L = K-1 

ILA13100 

i20* 


X = 9.0 

ILA13200 

i’dl* 

170 

lo z 9 

ILA13300 

I’dZ* 

lao 

X z X+XINC 

ILA13400 

iZi* 


Id z IBaI 

ILA13500 

i24« 


IF (IB ,L£. 10) 60 TO 185 

ILA13600 

X25* 


Ib z 1 

ILA13700 

ize* 


IF (ISW ,iME, 2) GO TO 185 

ILA13800 

iZ7* 


Ib z 2 

ILA13900 

iZB* 


L = L+1 

ILA14000 

rz9* 


X z 2.0 

ILA14100 


185 

CONTINUE 

ILA14200 



IF (ISW .£Q. 2) GO TO 190 

ILA14300 

X'^Z* 


YP z (X-Y.viIn)*ScLY+YB^i1 

ILA14400 

1^3* 


GO TO 200 

ILA14500 

I34>t‘ 

190 

YP z (ALOGl(j(X*10.0**U-XST)>t'SCLY+YBMl 

ILA14600 

A35* 

200 

IF (YP .LT. YBMA) gO to 180 

ILA14700 

A364C 


IF (YP .GT. Y6P,i+YSlZ£l) GO TO 240 

ILA14800 

137* 

210 

CONTINUE 

ILA14900 

138« 


IF (IB .LT. 10) GO TO 230 

ILA15200 

A39a 


call L1NE2V(IFIX(XP) »IFIX(YP) »IFIX(TIC1)*J,0) 

ILA15400 

140* 


IF (ISW .£Q. 2) GO TO 220 

ILA15500 

A41* 


Ib z O 

ILA15600 

142* 


IF (J .LT. 0) GO TO 240 

ILA15700 

A43* 


call NMBRS(X»NUM»NCHT) 

ILA15800 

144* 


XF z XP-FLOAT(NtHT)*ChARF-DlSP 

ILA15900 

A45* 


CALL PRINTV(NCHT»NUN»IFIX(XF) »IFIX(YP-.5«HT) ) 

ILA16100 

A46^ 


IF (XF .LT. XU) XD = XF 

ILA16200 

a47* 


GO TO 240 

ILA16300 

A48* 

220 

X z L+1 

ILA16400 

149* 


Ib z 1 

ILA16500 

ibO* 


IF (J .LT. 0) GO TO 225 

ILA16600 

ibl* 


call PRINTV(2, *10» ,1FIX(XP-4.0+CHARF-DISP) »IFIX(YP-.5*HT) ) 

ILA16900 

Itk* 


CALl LABLV(X»IFIX(XP-2.0*CHARF-DISP) ,IFIX(YP+DISP) fZtitZ) 

ILA17000 
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xt>3» 


^^b 

CylMUNUE 

ILA17100 

ib4* 



X = 1,0 

ILA17200 

ib5* 



L = L+1 

ILA17300 

Xb6« 



60 TO <i40 

ILA17400 

lb7* 


230 

CaUu LiNE2V(IFlX(XP) f IFIX(YP) f IFIX(TIC2)*J»0) 

ILA17600 

lb8* 


240 

continue 

ILA17700 

ib9* 



IF (YP ,LT, YoKl+YSi/tl) 60 TO l8o 

ILA17800 

ibO* 



XP = XLM1+XSI4E1 

ILA17900 

lbl» 



«j - "I 

ILA18000 

162* 


2bO 

Continue 

ILA18100 

163* 

C 


DKAw vertical axis LABEL 

ILA18200 

ifa4* 



XF = XU-DlSp-ChARF 

ILA18300 

ib5* 



YP = (YSIZEl+FLOATtNCV)*(HT+0ISp) )*0.b+YBNl 

ILA18500 

lb6* 



CALU APRNTV(Or-IFlX(HT+DISP) » nCV » VLABEL f IFIX (XP) » IFIX ( YP) ) 

ILA18700 

167* 

C 


horizontal AXlb LABEL 

ILA18800 

168* 



XP = (X5IZE1-FL0AT (NCh.)*CHARF)*0,b+XLMl 

ILA18900 

lb9* 



YP = YbMl-2.0*(2.b*C/ISP+HT) 

ILA19000 

i70* 



CALL PKlNTV(NCH»HLAbEL»IFlX(XP) ,IFIX(YP)) 

ILA19200 

171» 

C 


ONAft LEGEND FOR PuOT 

ILA19300 

172* 



Xp = (XSIZE1-90,0*CHAKF)*0,5+XLM1 

ILA19400 

173* 



YP = YP-HT+uISP 

ILA19600 

174* 



J = -89 

ILA19700 

175* 


2b0 

YP = YP-(HT+DISh) 

ILA19800 

1^6* 



0 — 0+90 

1LA19900 

l77* 



K - U+fa9 

ILA20000 

178* 



IF (K ,6T, NCHAR) K = NCHaR 

ILA20100 

179* 



I - (J/6)+l 

ILA20200 

ItiO* 



CALu PRINTV(K-J+1 .lLG£ND(I) »IFIX(XP)»IFIX(YP) ) 

ILA20400 

Ibl* 



IF (K .LT, NCHAK) OO TC 2b0 

ILA20500 

lb2^ 



RLTuRN 

ILA20600 

103* 



End 

ILA20700 
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!♦ subroutine lUPLOTr VERSION 5f REVISION 3 


2 * 


3* 



SUBROUT I NE ILPUOT ( X » Y » N » I SW r I J ) 

ILPOOlOO 

H* 

C 


TnIS SUBROUTINE PLOTS AND LABELS CURVES 

ILP00200 

5* 



CuM,viON /BNDS/ XKIT»XLFT, YfciOTr YToP»XPL»YPL 

JLP00300 

6* 



COMMON /ILPlTS/ XMAX»XMIN,YMAX»YMXN»XLMlf 

YBMl , HT » CHARF t SCLX r SCLY t ILP00400 

7* 


IXSlZElfYSlZfcl 

ILP00500 

B* 



DiMcNSlON X(l) ,Y(1) 

ILP00600 

9* 



common /XYXYPT/ YP(41) ,XP(41) »A(41) rBl41) 

»C(41) ,0(41) ,XI(41}»YI(41ILP00700 

10* 


1) fNuM(3) »WC 

ILP00800 

U* 



IFL6 - 0 

ILP00900 

12* 



JFLvp - 0 

ILPOIOOO 

13* 



DO 100 I=1»N 

ILPOUOO 




XI = X(I) 

ILP01200 

15* 



Y1 = Yd) 

ILP01300 

164< 



IF (XLFT ,LE* XI, and. XI .LE. XRiT) GO TO 

20 ILP01400 

17* 



GO TO 30 

ILP01500 

18* 


20 

IF (Ybot ,le. yi.and.yi ,le. ytoP) go to 

60 ILP01600 

19* 


30 

IF (UFLG fEu. 0) GO TO 50 

ILP01700 

20* 

C 


LAST POINT WAS OUTf THIS POINT IS OUT 

ILP01800 

21* 


40 

lU(i) = 3 

ILP01900 

22* 



60 TO 90 

ILP02000 

23* 


50 

uFLG = 1 

ILP02100 

24* 



IF (I .EQ. 1) GO TO *^0 

ILP02200 

25* 

C 


This POINT OUT LAST POINT IN 

ILP02300 

26* 

c 


interp for plot point 

ILP02400 

27* 



CmLl BOUNDS (XI, Y1 » XLSl »YLST) 

ILP02500 

2b* 



ITAG = 1 

1LP02600 

29* 



GO TO 80 

ILP02700 

30* 


dO 

IF (UFLG .EO. 0) GO TO 70 

ILP02800 

31* 

c 


THIS POINT IN LAST POINT OUT 

ILP02900 

32* 



UHLG - 0 

ILP03000 

33* 



call BOUNuS(XLST,YLSTrXl,Yl) 

JLP03100 

34* 



lo(l-l) = 0 

ILP03200 

35* 



X(I-l) = (XPL-XlFT)*ScLX+XLM1 

ILP03300 

36* 



Y(I-l) = (YpL-YbOT)*SCLY+YBMl 

ILP03400 

37* 


70 

XPL = XI 

ILP03500 

38* 



YPL = Y1 

XLP03600 


09* 



ITAb - 2 

ILP03700 

^0* 


so 

X(I) = (XPL-XuFT)*SCLX+XLMl 

ILP03800 




YU) = {YPL-YQOT)*StLY+YBMl 

ILP03900 

42* 



UU) = ITAC? 

ILP04000 

43* 


90 

XuST = XI 

ILP04100 

44* 



YLST = Y1 

ILP04200 

45* 


iOO 

continue 

ILP04300 

46* 



IP USW .£Q, 2) GO TO 160 

ILP04400 

47* 

C 


IP = 0 curve ENIEKS graph - FIRST POINT 

ILP04500 

4B* 

C 


Ip = 1 CURVE LEAVES GRAPH - LAST POINT 

ILP04600 

49* 

C 


Ip = 2 curve CONTINUES WITHIN GRAPH 

ILP04700 

bO* 

c 


IP = 3 curve OUTSIDL of graph do not PLOT 

ILP04800 

bl* 

c 



ILP04900 

b2* 

c 


FiNp POINTS FOR IbOPLETH LABELS 

ILP05000 

b'i* 

c 


find all points where curve LEAVES GRAPH 

ILP05100 

b4* 



M = 0 

ILP05200 

b5^ 



DO 110 I=1»N 

ILP05300 

^ b6+ 



IP (IPU) .NE. 1) bO TO 110 

ILP05400 

b7* 



M = M+1 

ILPC5500 

b&« 



B(M) = XU) 

ILP05600 

b9* 



C(M) = YU) + ,02 

ILP05700 

60* 


no 

continue 

ILP05800 

61* 

c 


FiNu all points where curve enters GRAPH 

ILP05900 

bZ* 



DO 120 I=1»N 

ILP06000 

b3* 



IP (IJU) *NE. 0) GO TO 120 

1LP06100 

b44t 



M = M+1 

ILP06200 

b5* 



B(M) = XU) 

IUP06300 

bb* 



C(M) = YU) + ,02 

ILP06400 

b7* 


120 

CONTINUE 

ILP06500 

b6* 



L = N/2 

ILP06600 

b9* 



IF UJ(L) .£Q, 2) GO TO 130 

ILP06700 

70» 



L = 1 

ILP06800 

?!♦ 



IF (IJ(L) .£Qt 2) GO TO 130 

ILP06900 

7Z* 



L = N/4 

ILP07000 

73* 



IP (IP(L) .EQ» c) gO TO 130 

ILP07100 

74* 



L = 3*N/4 

ILP07200 

7b* 



IP UJ{L) .NE, 2) GO TO 140 

ILP07300 

76* 


130 

M = M+i • 

ILP07400 
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BIM) = XU.) 

C{M) = Y(L)+.02 
140 CONTINUE 
PLOT labels 
XPL = -xu-t*sclx+xlmi 
YPL = -YB0T<<SCLY + YBN1 
DO 150 1=1 »Ni 

If- (ABS(XPL-B(I) ) ,GT. 0,2) GO TO 145 

IP (AUS(YPL-Ca) ) ,LE. 0,2) 60 TO 150 

iHb CONTINUE 

‘call PPlNTV(NC»NUPi,lFIX(Oa) > »IFIX(C(I) )) 

150 continue 
ibo continue 

PLOT the CUKVt 

IF (lU(l) ,ImE, 5) lUU) = 0 

N = N-1 

DO 170 1=1 »N 

IF (IJ(I+1) ,cQ, 3) GO TO 170 

If lIJ(I+i) ,£Q, 0) GO TO 170 

CALl LlNE2VaFIX(X(I) ) »IF1X(Y(I) ) ,IFIX(X(I+1) 
II))) 

170 continue 

ItiO continue 

RtTuRN 
END 


ILP07500 

ILP07600 

ILP07700 

ILP07800 

ILP07900 

ILP08000 

1LP08100 

ILP08200 

ILP08300 

ILP08400 

IUP06600 

IUP08700 

ILP08800 

ILP06900 

ILP09000 

ILP09100 

ILP09200 

ILP09300 

ILP09400 

•X(I) ) »IFIX(Y(I+1)-Y(ILP09500 

ILP09600 
ILPIOOOO 
ILPlOlOO 
ILP10200 
ILP10300 


1* 

z* 

341 


SUBROUTINE CALCS, VERSION 5, REVISION 3 

SUBROUTINE CAlCS ( XX » YY , NP , RAD , RaDI » XSHFT , YSHFT r Xl » Y1 , LUSW , KB » YT ( 

•XfCALOOlOO 

4* 

INX) 

CAL00200 

5* 


dimension XX(1) ,YY(1) »XSH(2) »X(1) 

CAL00300 

641 


IF (LLSW .NE. 0) 00 TO 10 

CAL00400 

7* 


IF iKb .NE. 0) 00 TO 260 

CAL00500 

&4C 


DO 200 I=1»NP 

CALC0600 

94f 


IF (XX(I) ,LT, 100.0) 60 TO 210 

CAL00700 

1041 

o 

o 

CM 

continue 

CAL00800 

11* 


GO TO 260 

CAL00900 

12* 

210 

X2 = I.OEIO 

CALOIOOO 

13* 


DO 220 1=1 »NP 

CALOllOO 

14* 


Y2 = ABS(YYU)-YT) 

CAL01200 

15* 


IF (Y2 ,GT. lao.O) Y2 = 360.0-Y2 

CAL01300 

16* 


IF (Y2 .SE. X2) GO TO 220 

CAL01400 

17* 


X2 z Y2 

CAL01500 

16* 


J = I 

CAL01600 

19* 

220 

CONTINUE 

CAL01700 

20* 


X2 z XX(1) 

CALOiaOO 

21* 


Y2 z YY(1) 

CAL01900 

22* 


XX(i) = XX(o) 

CAL02000 

23* 


YY(1) = YYtJ) 

CAL02100 

24* 


XX(J) z X2 

CAL02200 

25* 


YY(o) = Y2 

CAL02300 

26* 


I = 1 

CAL02400 

27* 

230 

I = I + l 

CAL02500 

26* 


IF (I .6T, NP) 00 TO 260 

CAL02600 

29* 


IF (XX(I) .OE. 100,0) 60 TO 230 

CAL02700 

30* 


1 = 1+1 

CAL02800 

31* 


IF (I .GT, NP) 60 TO 250 

CAL02900 

32* 


DO 240 K=I»NP 

CAL03000 

33* 


YY(K-I) = YY(K) 

CAL03100 

34* 

240 

XX(K-l) = XX(K) 

CAL03200 

35* 


I = 1-2 

CAL03300 

36* 

250 

NP z NP-1 

CAL03400 

37* 


GO TO 230 

CAL03500 

36* 

o 

^0 

CM 

CONTINUE 

CAL03600 
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39* 

c determine center of function 

CAL03700 

40« 

XSHfT = -I.OEIO 

CAL03800 

HI* 

YSHFT = -X.OEXO 

CAL03900 

42 * 

X2 = I.OEIO 

CAU04000 

43* 

Y2 s I.OEIO 

CAL04100 

4H* 

DO 4 1=1 »NP 

CAL04200 

45* 

XSHFT = AMAX1(XSHFT»XX(D) 

CAL04300 

46* 

YSHfT = AMAX1(YSHFT»YY(D) 

CAL04400 

47* 

X2 = AMIN1(X2*XX(1) ) 

CAL04500 

48* 

Y2 = AMIN1(Y2»YY(D) 

CAL04600 

49* 

4 CONTINUE 

CAL04700 

bO* 

XSHFT = 0,5*(XSHFT+X2) 

CAL04800 

bX* 

YSHfT = 0,5*(YSHFT+Y2) 

CAL04900 

b2* 

IF (KB ,NE, 0) 60 TO 9 

CAL05000 

b3* 

XSHFT = 0,2*XSHFT+0*8*X2 

CAL05100 

b4* 

D1F2 = -IfO 

CAL05200 

b5* 

D1F3 = 0.0 

CAE05300 

b6* 

DO 350 L=1»NX 

CAL05400 

b7* 

DO 300 K=1»NP 

CAL05500 

be* 

IF (XX(K)*‘X(D) 300»310»300 

CAL05600 

b9* 

300 CONTINUE 

CAL05700 

bO* 

60 TO 350 

CAL05800 

bi* 

310 Y2 = YY(K) 

CAL05900 

b2* 

K = K+1 

CAL06000 

b3* 

IF (K .6E. NP) 60 TO 350 

CAL06100 

b4* 

DO 320 J=K»NP 

CAL06200 

b5* 

IF (XX(J)-X(U) 320»330»320 

CAL06300 

b6* 

320 CONTINUE 

CAL06400 

b7* 

60 TO 350 

CAL06500 

b8* 

330 DlFl = DIF2 

CAL06600 

b9* 

DIF2 = DIF3 

CAL06700 

70* 

D1F3 = ABS(YY(0)-Y2) 

CAL06800 

71* 

IF (DIF3 .6T. 180.0) 0IF3 = 360.0-DIF3 

CALC6900 

72* 

IF (DIFl .LE. DIF2.0R.DIF2 .GE. DIF3) GO TO 340 

CAL07000 

73* 

YSHfT = X2 

CAL07100 

74* 

60 TO 360 

CAL07200 

75* 

340 CONTINUE 

CAL07300 

76* 

X2 = 0.5*(YY(J)+Y2) 

CAL07400 
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77* 

78* 

79* 

80* 

81* 

82* 

83* 

84* 

85* 

86 * 

87* 

88 * 

89* 

90* 

91* 

92* 

93* 

94* 

95* 

96* 

97* 

98* 

99* 

100 * 

101 * 

102 * 

103* 

104* 

105* 

106* 

107* 

108* 

109* 

llO* 

111 * 

112 * 

113* 

114* 


350 CONTINUE 
eo TO 9 
360 CONTINUE 
DO 5 J=2»NP 
DO 5 1=2 »NP 

IF (XX(I) »6E, XX(I-D) GO TO 5 
X2 = XX(I) 

Y2 = YY(I) 

XX(l) = XX(X-l) 

YYU) = YY(I«i) 

XX(I-l) = X2 
YY(i-l) = Y2 
5 continue 
DO 8 

X5H(J) = 0*0 
DIF2 = -2,0 
DIF3 = -IfO 
DO 7 1=1 »NP 

IF (J .EQ. l.ANO.YYd) .DE, YSHFT) 60 TO 7 
IF (J .EQ. 2.AN0.YYII) ,6E. YSHFT) 60 TO 7 
DlFl = DIF2 
D1F2 = DIF3 

D1F3 = ABS(YY(I)-YSHFT) 

DIF3 = RAD*0IF3*XX(I) 

IF (OIFl .Le. 0IF2.0R.DIF2 .6E. DIF3) GO TO 7 
XSHlJ) = XX(I-l) 

60 TO 8 

7 CONTINUE 

8 CONTINUE 

IF (XSH(l) .U£. 0,O.OK.XSH(2) .LE. 0.0) 60 TO 9 
X5H(1) = AMAX1(XSH(1)»XSH(2)) 

XSHpT = XSHU) 

9 continue 

Y2 = YSHFT*RAD 
YbHpT = XSHFT*C0S(Y2) 

XSHfT = XSHFT*SIN(Y2) 

10 continue 

C CONVERT TO RECTaNOULAR 


CAL07500 

CAL07600 

CAL07700 

CAL07800 

CAL07900 

CAL08000 

CAL06100 

CAL08200 

CAL08300 

CAL08400 

CAL06500 

CAL08600 

CAL0B700 

CALC8800 

CAL08900 

CAL09000 

CAL09100 

CAL09200 

CAL09300 

CAL09400 

CAU09500 

CAL09600 

CAL09700 

CAL09800 

CAU09900 

CALIOOOO 

CALlOlOO 

CAL10200 

CAL10300 

CAL10400 

CAL10500 

CAL10600 

CAL10700 

CAL10800 

CAU1C900 

CALllOOO 

CALlllOO 

CAL11200 
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il5* 



DO 11 I=1»NP 

CAL11300 

U6* 



Y2 = YY(I)*RAD 

CAL11400 

il7* 



YY(I) = XX(1)*C0S{Y2)+Y1 

CAL11500 

il6« 



XA(I) = XX(I)*51MY2)+X1 

CAL11600 

a19* 


u 

CONTINUE 

CAL11700 




If- (LLSW .EO. 2) 00 TO 101 

CALllSOO 

i21* 



DO 20 I=1»MP 

CAL11900 

122* 



IF (LLSW .EO. 1) 60 TO 17 

CAL12000 

x23« 

C 


CONVERT points TO SYSTEM RELATIVE TO CENTER OF ELLIPSE 

CAL12100 

124» 



XX(i) = XX(X)-XSHFT 

CAL12200 

i25* 



YY(l) = YY(i)-YSHFT 

CAL12300 

i26* 


17 

continue 

CAL12400 

127* 

C 


BACK TO polar 

CAL12500 

a2B« 



IF (XX(D) I9»l6fi9 

CAL12600 

129* 


Id 

IF (YY(I); 19»20,19 

CAL12700 



19 

YPL = 90.0-ATAN2(YY(I) »XX(I) )*RaDI 

CAL12800 

iiU 



IF (YPL .LT, 0,0) YPL = YPL+360,0 

CAL12900 

i32« 



XX(l) = SaRT(XX(I)*XX(I)+YY(I)>t'YY(I) ) 

CAL13000 

1«53* 



YY(i) = YPL 

CAL13100 

134* 



IF (LLSW ,EO. 1) YY(I) = AMOD(YPL» 360,0) 

CAL13200 

135* 


20 

CONTINUE 

CAL13300 

136» 



IF (LLSW ,EQ. 1) 60 TO 101 

CAL13400 

137* 

C 


SORT POINTS into ASCENDING ORDER OF ANGLE 

CAL13500 

x38* 



DO 30 M=2»Np 

CAL13600 

A39* 



DO 30 1=2 »NP 

CAL13700 

140* 



IF (YY(I) ,6E, YY(I-D) GO TO 3o 

CAL13800 

i41* 



YPL = YY(i) 

CAL13900 

142* 



YT(i) = YY(I-l) 

CAL14000 

i43* 



YY(l-l) = YPL 

CAL14100 

i44* 



YPL = XX(i) 

CAL14200 

145* 



XX(i) = XX(I-l) 

CAL14300 

A46* 



XX(I-l) = YpL 

CAL14400 

147* 


30 

continue 

CAL14500 

i46* 

C 


ELli^INATE unwanted POINTS 

CAL14600 

149* 



I = 1 

CAL14700 

IbO* 


32 

1 = 1+1 

CAL14800 

lbl« 



IF (I ,GT, NP) 60 TO 35 

CAL14900 

Xb2« 



IF (YY(I)-YY(i-l) ,6E, 1.0) GO TO 32 

CAL15000 


i.b3>tc 


1 = 1+1 

CAL15100 



Ih ( I .GT, NP) GO TO 34 

CAL15200 

ib5« 


DO 33 0=1 fNp 

CAL15300 

ib6« 


YY(3-1) = YY(0) 

CAL15400 

xb7* 

33 

XX(u-l) = Xa(v<) 

CAL15500 

XbS^c 


I = 1-2 

CAL15600 

lb9* 

34 

NP - NP-1 

CAL15700 

Xb04< 


GO 10 32 

CAL15800 

Abl^ 

3b 

CONTINUE 

CAL15900 

xbZ* 


IP iKB ,Nt. 0) GO TO 101 

CAL16000 

lt>2t 

C 

eliminate Any PoiNTb that are Hidden from direct 

SIGHT FROM CENTERCAL16100 

ibH* 


0 = 0 

CAL16200 

ib5* 

40 

0 = 0+1 

CAL16300 

ibS^c 


IF lO tGE. nP-1) 00 TO 50 

CAL16400 

ibl* 


01 = 0 + 1 

CAL16500 

ibS* 


02 = 01+9 

CAL16600 

ib9* 


IF (02 ,GT, NP) 02 = NP 

CAL16700 

g X70* 

41 

IF (AbS(YY(O)-Y'r (02) ) ♦LE, 10,0) 60 TO 42 

CAL16800 

CO 


02 = 02-1 

CAL16900 

172* 


GO TO 41 

CAL17000 

a73* 

42 

IF (02 ,LT. 01) GO TO 40 

CAL17100 

174* 


Y2 = YY(0)*RAO 

CAL17200 

l75* 


X2 = XX(0)*SIN(Y2) 

CAL17300 

a76* 


Y2 = XX(0)*C0S(Y2) 

CAU17400 

177* 


XT = 1.0E20 

CAL17500 

ive* 


M = 01 

CAL17600 

179* 


DO 45 l=01ro2 

CAL17700 

IbO* 


Th2 = YY(1 )*RmD 

CAL17800 

Ibl* 


Thl = XX(A)*SIN(TH2) 

CAL17900 

a02* 


Th2 = XX(i)*C0S(TH2) 

CAL18000 

Att3* 


XP = (X2-TH1)**2+(Y2-TH2)**2 

CAL18100 

164* 


IF (XP ,Gt, XI) GO TO 45 

CAL18200 

Ibb* 


XT = XP 

CAL16300 

166* 


M = I 

CAL18400 

167* 

4b 

CONTINUE 

CAL18500 

a66* 


IF (M ,EQ. Ol) GO TO 40 

CAL18600 

169* 


Thl = XX(Ol) 

CAL18700 

Ayo* 


Th2 = YY(Ol) 

CAL18800 
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i91* 


XA(Ul) = XX(M) 

X92* 


YY(jl) = YY(M) 

X93* 


XX (M) = THl 

194* 


YY(M) = TH2 

195* 


GO TO 40 

i96* 

bO 

continue 

l97* 


J = 1 

X9ti« 

5b 

J = J+1 

i99# 


IF (J .GT, NP) GO TO 70 



IF (YY(J) .GT. YY(O-D) eo TO 55 



01 — 0*^1 

202* 


IF (J1 .6T. NP) GO TO 65 

203« 


DO 60 I=sil»NP 

204« 


XX<i-l) = XX(i) 

C.U5* 

60 

YY(l-l) = YY(i) 

206« 


J = J-1 

207* 

65 

NP = NP-1 

«.0B* 


GO TO 55 

2U9« 

70 

continue 

£l0« 

101 

RETURN 

2U4C 


END 


CAL18900 

CAU19000 

CAL19100 

CAL19200 

CAL19300 

CAL19400 

CAL19500 

CAL19600 

CAL19700 

CAL19800 

CAL19900 

CAL20000 

CAL20100 

CAL20200 

CAL20300 

CAL20400 

CAL20500 

CAL20600 

CAL20700 

CAU20800 

CAL20900 



1* 

z* 

3* 


SOBkOUTINE FSTPLT» version 5, REVISION 3 



SOBKOUTINE FSTPUTU»B»CrI»J»K»D»E»FfVlrV2»V3rNX»N2»N3,XP) 

FSTOOlOO 

4* 


Dimension i(i)rj(i) »ku) »lstk(2)»vi(D »v2(1)»v3(1) 

FST00200 

5* 


data MTRS/6HM£TeRS/ 

FST00300 

&♦ 


IF (KU) .eg, LSTK(1) .AND,K(2) .EG. LSTK(2)) GO TO 40 

FST00400 

?♦ 


call SETMIV(0, 0,0,0) 

FST00500 

8« 


CALL FRAMEV(O) 

FST00600 

9* 


CALL PRINTV(72, 1,200,800) 

FST00700 

10« 


CALL PRINTV(37,37HA0JUSTED CLOUD STABILIZATION HEIGHT s, 200,750) 

FST00800 

11* 


call LABLV(A»504,750,7,1,4) 

FST00900 

12* 


call PRINTV(6,MTRS,U68,750) 

FSTOIOOO 

IZ* 


CALL PRlNTVi7,7HRANeE =,200,725) 

FSTOllOO 

in* 


CmLl LABLV(B»272,72B,7,1,5) 

FST01200 

15* 


call PRINTV(6,MTRS,336,725) 

FST01300 

164c 


CALL PRlNTVa7,17HA^lMUTH BEARING =,200,700) 

FST01400 

17* 


call LABLV(C»352,700,b,l,3) 

FST01500 

g 18* 


call PRINTV(7,7hOEGRELS,4l6,700) 

FST01500 

cn i9* 


CALL PRINTV(8,8HRUN DATE, 200, 65q) 

FST01700 

2041 


call PRINTV(6,J,288»650) 

FST01800 

21« 


CALL PRINTV(8,8hRUN TIME, 400, 65o) 

FST01900 

224c 


CALL PRlNTV(8,K,488r650) 

FST02000 

234c 


lUY = 625 

FST03800 

24« 


IF (N1 ,LT. 0) GO TO 10 

FST03900 

25« 


IDY = IDY-25 

FST04100 

26« 


CmLl PRlNTV(7,7hMAXlMUM,200, IDY) 

FST04200 

274c 


Call PRINTViN1,V1,264,IDY) 

FST04300 

284c 


call LABLV(0»264+84c(N1+1) ,IOY,-6,1,0) 

FST04400 

29* 

10 

IF (N2 ,LT. 0) GO TO 20 

FST04800 

304c 


IDY = IDY-25 

FST05000 

31* 


call PR intv ( 7 , 7HMAXIMUM , 200 , IDY ) 

FST05100 

324c 


call PRINTV(N2,V2,2G4,IDY) 

FST05200 

334c 


Call LABLV(E,264+8*(N2+1) ,IDY,-6,1,0) 

FST05300 

344c 

20 

IF (N3 ,LT, 0) GO TO 30 

FST05700 

35* 


IDY = IDY-25 

FST05900 

364c 


CALL PRINTV(7,7hMAXIMUM,200,IDY) 

FST06000 

374c 


call LABLV(XP,264,IDY,4,1,2) 

FST06100 

384c 


call PRINTV(6,6hMINUTE,304,IDY) 

FST06200 
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^9* 

CALL PRINTV(N3»V3»3&2»I0Y) 

FST06300 

HO* 

call LABLV(F»352+ti*(N3+l) »IDY»-6»1»0) 

FST06400 

41* 

30 CONTINUE 

FST07000 

42* 

LbTK(l) = K(l) 

FST07200 

43* 

LSTk(2) = K(2) 

FST07300 

44* 

40 RtTuRN 

FST07400 

4b* 

END 

FST07500 





to 

to 

<1 


1* 


subroutine maxmxn» version 

2* 

3* 


subroutine MAXMIN(A»B»C»D»E 

4* 

C 

This subroutine determines 

5* 

C 

distance a»b are input max 

6* 

C 

determine Max and min 

7* 


IF (ISW ,EQ, 2) go to 10 

a* 


IF lA .GT, 0,0) GO TO 80 

9* 

C 

linear scaling 

10* 


C = E 

n* 


D = F 

12* 


GO TO 90 

13* 


10 continue 

14* 


XX = 4,0 

15* 


IF (A ,GT, 0.0) XX = A 

16* 

C 

LOG-LOG SCALING 

17* 


C = ALOGlO(E) 

18* 


K = C 

19* 


X = K 

20* 


IF (X-C) 20»30»20 

21* 


20 K = K+1 

22* 


30 C = 10,0**K 

23* 


D = 1.0 

24* 


IF (F .LE, 0,0) 60 TO 40 

25* 


D = F 

2b* 


40 D = ALOGlO(D) 

27* 


J = D 

28* 


X = u 

29* 


IF (X-D) 50,60.50 

30* 


50 IF (D .LT, 0.0) J = 0-1 

31* 


60 IF (FLOaT(K-J) ,LE. XX) 60 

32* 


0 s 0*1 

33* 


60 TO 60 

34* 


7C D = 10, 0**0 

35* 


60 TO 90 

36* 


80 C = A 

37* 


D = B 

38* 


90 return 


5, REVISION 1 
»F»ISW) 

MAX & MIN FOR PLOTTING FUNCTION VS, 

and min» c and d are calc max and min 


TO 70 


MaXOOIOO 

MAX00200 

MAX00300 

MAX00400 

MAX00500 

MAX00600 

MAX00700 

MAX00800 

MAX00900 

MAXOIOOO 

MAXOUOO 

MAX01200 

MAX01300 

MAX01400 

MAX01500 

MAX01600 

maxoitoo 

MAX01800 

MAX01900 

MAX02000 

MAX02100 

MAX02200 

MAX02300 

MAX02400 

MAX02500 

MAX02600 

MAX02700 

MAX02800 

MAX02900 

MAX03000 

MAX03100 

MAX03200 

MAX03300 

MAX03400 

MAXC3500 

MAX03600 
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i9* 


END 


MAX03700 



2 * 

3 * 



subroutine bOUN[)S» version 5r REVISION 1 




SUBROUTINE tjOUNQS ( Xl » Y1 » XLST » YLST ) 

BNDOOIOO 

4* 

C 


confine plot points inside of axes 

BND00200 

5* 



common /BNDS/ XRIT»XLFT»YBOT»YToP»XPL»YPL 

BND00300 

6* 



A = (YLST-Y1)/(XLST-X1) 

BND00400 

7* 



B = Y1-A*X1 

BND00500 




IF (XI ,GT, XRIT) go to 90 

BND00600 

9* 



IF (Xi .LT. XLFT) 60 TO 60 

BND00700 

10« 



IF (Y1 .LT, YaOT) GO TO 20 

6ND00600 

11* 



YPL = YTOP 

BND00900 

12* 


10 

XPL = (YPu-b)/A 

BNDOIOOO 

13* 



GO TO 110 

BNDOllOO 

14* 


20 

IF (XI ,GT. XRIT) 60 TO 50 

BND01200 

15* 



IF (XI ,LT. XLFT) GO TO 30 

BN001300 

16* 



YPL = YBOT 

BND01400 

17* 



60 TO 10 

BN001500 

16* 

C 


lower left hand corner ASSUME CROSSES XLFT 

6N001600 

19* 


30 

XPL = XLFT 

BND01700 

20* 


40 

YPL = A*XPL+B 

BND01600 

21* 



IF (YPL .GE. YBOT) 60 TO 110 

BND01900 

22* 

C 


wrong crosses YBOT 

BND02000 

23* 



YPL = YBOT 

BND02100 

24* 



60 TO 10 

BND02200 

25* 

C 


lower right hand corner assume crosses XRIT 

BN002300 

26* 


50 

XPL = XRIT 

BND02400 

27* 



GO TO 40 

BND02500 

26* 


60 

IF (Y1 ,6T. YTOP) 60 TO 70 

BND02600 

29* 



IF (Y1 ,LT, YBOT) 6© TO 30 

BND02700 

30* 



XPL = XLFT 

BND02600 

31* 



60 TO 40 

BND02900 

32* 

C 


upper left hand corner assume CROSSES XLFT 

BN003000 

33* 


70 

XPL = XLFT 

BND03100 

34* 


60 

YPL = A*XPL+B 

BND03200 

35* 



IF (YPL ,LE, YTOP) GO TO 110 

BND03300 

36* 

C 


wrong CROSSES YTOP 

BN003400 

37* 



YPL = YTOP 

BND03500 

36* 



GO TO 10 

BND03600 
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39* 

90 

IH (Y1 ,LT. 

YbOT) 

qo to 

50 

HO* 


IF (Y1 ,6T. 

Y(OP) 

tiO TO 

100 

HI* 


XFL = XRIT 




H2* 


GO TO 40 




H3* 

C 

UPP£R RIGHT 

hand 

corner 

ASSUME 

HH* 

100 

XPL = XRIT 




H5* 


GO 10 80 




H6* 

110 

RETURN 




H7* 


END 





BND03700 

BND03800 

6ND03900 

BN004000 

CROSSES XRIT BND04100 

BND04200 

BND04300 

BND04400 

BN004500 
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